0
\$\begingroup\$

This code creates a class module that record headers in to a dictionary which then allows for copy and paste data from another file where by the headers match. This helps to create a more dynamic table i.e. users can add/remove columns without changing the code (as long as they observe limitations).

The idea:

  • File 1 D1 <--- Dict that contain header as KEY and column number as Value
  • File 2 D2 <--- Dict that contain header as KEY and column number as Value

Cycle through D1 header and call out D2 (key)i.e. D1 header is "SKU" in File 1, so I call out D2("SKU"). If it exists, I will grab that column data in File 2 and paste it into File 1.


I have been coding VBA for quite sometime now and it is only recently that I have begun diving into doing up some class module.

Some questions on my mind is, when should I stop including functions and properties in a class? I am creating a class module where by it record table properties (i.e. row of header column). I went on further to create a retrieve data function where it gets data from other table with the same class.

  1. Am I overdoing it? I tend to want to put all the function in one class. I have been thinking of adding more function like assigning workbook, worksheets, function to filldown certain columns etc, is this a good idea, or should I leave this as a separate function outside the class module?

  2. If I want to set all classes to have the same default initialization do I declare a public const in the class module itself or the normal modules?

Here is my class module:

Private pHeaderNames As Object
Private pHeaderRow As Long
Private pSubHeaderNames As Object
Private pSubHeaderRow As Long
Private pDataRowStart As Long
Private pInputColStart As Long
Private pTableColStart As Long
Private pHeaderLastCol As Long
Private pTblWorksheet As Worksheet
Private pFileURL As String
Private pFileName As String
'---------------------------------------------- Initialization'
Private Sub Class_Initialize()
 pHeaderRow = 1
 pDataRowStart = 2
 pTableColStart = 1
 pInputColStart = pTableColStart
 pSubHeaderRow = pHeaderRow
 pHeaderLastCol = Cells(pHeaderRow, Columns.Count).End(xlToLeft).Column
 Set pHeaderNames = CreateObject("Scripting.Dictionary")
 Set pSubHeaderNames = CreateObject("Scripting.Dictionary")
End Sub
Public Property Get FileURL() As String
 FileURL = pFileURL
End Property
Public Property Let FileURL(Value As String)
 pFileURL = Value
End Property
Public Property Get FileName() As String
 FileName = pFileName
End Property
Public Property Let FileName(Value As String)
 pFileName = Value
End Property
Function OpenWorkbook(URL As String, Name As String)
 pFileURL = URL
 pFileName = Name
 Call Workbook_open(pFileURL, pFileName)
End Function
Public Property Let SetSheet(Value As String)
 If pFileName - "" Then
 Set pTblWorksheet = ActiveWorkbook.Worksheets(Value)
 Else
 Set pTblWorksheet = Workbook(pFileName).Worksheets(Value)
 End If
End Property
Public Property Get TblWorksheet() As Worksheet
 TblWorksheet = pTblWorksheet
End Property
Public Property Let TblWorksheet(Sheet As Worksheet)
 pTblWorksheet = Sheet
End Property
'---------------------------------------------- HeaderLastCol'
Public Property Get HeaderLastCol() As Long
 HeaderLastCol = pHeaderLastCol
End Property
Public Property Let HeaderLastCol(Value As Long)
 pHeaderLastCol = Value
End Property
'---------------------------------------------- HeaderRow'
Public Property Let HeaderRow(Value As Long)
 pHeaderLastCol = Cells(pHeaderRow, Columns.Count).End(xlToLeft).Column
 pHeaderRow = Value
End Property
Public Property Get HeaderRow() As Long
 HeaderRow = pHeaderRow
End Property
'---------------------------------------------- SubHeaderRow'
Public Property Let SubHeaderRow(Value As Long)
 pSubHeaderRow = Value
End Property
Public Property Get SubHeaderRow() As Long
 SubHeaderRow = pSubHeaderRow
End Property
'---------------------------------------------- InputColStart'
Sub SetInputColStart(KEY As Variant)
 pInputColStart = pHeaderNames(KEY)
End Sub
Public Property Get InputColStart() As Long
 InputColStart = pInputColStart
End Property
Public Property Let InputColStart(Value As Long)
 pInputColStart = Value
End Property
'---------------------------------------------- DataRowStart'
Public Property Get DataRowStart() As Long
 DataRowStart = pDataRowStart
End Property
Public Property Let DataRowStart(Value As Long)
 pDataRowStart = Value
End Property
'---------------------------------------------- TableColStart'
Public Property Get TableColStart() As Long
 TableColStart = pTableColStart
End Property
Public Property Let TableColStart(Value As Long)
 pTableColStart = Value
End Property
'---------------------------------------------- HeaderName'
Sub GetHeaderNames()
 With pHeaderNames
 For i = pTableColStart To pHeaderLastCol
 If Not .Exists(UCase(Cells(pHeaderRow, i).Value)) Then
 .Add UCase(Cells(pHeaderRow, i).Value), i
 End If
 Next i
 End With
End Sub
Function HeaderName(KEY As String)
 If pHeaderNames.Exists(KEY) Then
 HeaderName = pHeaderNames(KEY)
 Else
 HeaderName = ""
 End If
End Function
Function CountHeaderNames()
 CountHeaderNames = pHeaderNames.Count
End Function
Function PrintHeaderObject()
 For Each KEY In pHeaderNames.keys
 Debug.Print KEY, pHeaderNames(KEY)
 Next
End Function
'---------------------------------------------- SubHeaderName'
Sub GetSubHeaderNames()
 With pSubHeaderNames
 For i = pTableColStart To pHeaderLastCol
 If Not .Exists(UCase(Cells(pSubHeaderRow, i).Value)) Then
 .Add UCase(Cells(pSubHeaderRow, i).Value), i
 End If
 Next i
 End With
End Sub
Function SubHeaderName(KEY As String)
 If pSubHeaderNames.Exists(KEY) Then
 SubHeaderName = pSubHeaderNames(KEY)
 Else
 SubHeaderName = "" 'or raise an error...
 End If
End Function
Function CountSubHeaderNames()
 CountSubHeaderNames = pSubHeaderNames.Count
End Function
Function PrintSubHeaderObject()
 For Each KEY In pSubHeaderNames.keys
 Debug.Print KEY, pSubHeaderNames(KEY)
 Next
End Function
Function RetrieveData(FromSht As Worksheet, ByVal FromTable As cTable)
 Dim KEY As String
 'CurrentSht = ActiveSheet
 For i = pTableColStart To pHeaderLastCol
 KEY = Cells(pHeaderRow, i).Value
 If FromTable.HeaderName(KEY) = "" Then
 GoTo Nexti
 Else
 With FromSht
 .Activate
 rD_LastRow = 10
 Set Source = .Range(.Cells(FromTable.DataRowStart, FromTable.HeaderName(KEY)), _
 .Cells(rD_LastRow, FromTable.HeaderName(KEY)))
 End With
 With CurrentSht
 .Activate
 .Range(.Cells(DataRowStart, i), _
 .Cells(DataRowStart, i)) _
 .Resize(Source.Rows.Count, Source.Columns.Count).Cells.Value = Source.Cells.Value
 End With
 End If
Nexti:
 Next i
End Function

Here is the module, so you can see that I have always need to declare headerRow, subHeaderRow and Datarowstart, even though I have a default initialization set in the class module. Is there away to change the default initialization based on the main module, or should I just have to do it in the class module? (I trying to make the class portable.)

Sub test()
Dim sht As Worksheet
Set wb = ActiveWorkbook
Set sht = wb.Sheets("Skin(Units)")
With Worksheets("Skin(Units)")
 .Activate
 Set SkinUnits = New cTable
 Debug.Print TypeName(SkinUnits)
 SkinUnits.HeaderRow = 1
 SkinUnits.SubHeaderRow = 3
 SkinUnits.DataRowStart = 4
 SkinUnits.GetHeaderNames
 SkinUnits.GetSubHeaderNames
 SkinUnits.PrintHeaderObject
 SkinUnits.PrintSubHeaderObject
 SkinUnits.SetInputColStart ("Start")
End With
With Worksheets("Pain(Units)")
 .Activate
 Set PainUnits = New cTable
 PainUnits.HeaderRow = 1
 PainUnits.SubHeaderRow = 3
 PainUnits.DataRowStart = 4
 PainUnits.GetHeaderNames
 PainUnits.GetSubHeaderNames
 PainUnits.PrintHeaderObject
 PainUnits.PrintSubHeaderObject
 PainUnits.SetInputColStart ("Start")
 Debug.Print PainUnits.HeaderName("SKU")
 Debug.Print TypeName(sht), TypeName(SkinUnits)
 Call test22222(SkinUnits)
 Call PainUnits.RetrieveData(sht, SkinUnits)
End With
End Sub
Function test22222(ByVal X As cTable)
 Debug.Print X.HeaderRow
End Function
FreeMan
1,3008 silver badges16 bronze badges
asked Aug 17, 2018 at 5:05
\$\endgroup\$
1
  • \$\begingroup\$ There seem to be some leftover formatting issue, can you verify your code? Nexti: Next i End Function \$\endgroup\$ Commented Aug 17, 2018 at 7:20

1 Answer 1

1
\$\begingroup\$

First, having parameters in initialization is overloading - and no it's not possible in VBA. Your best bet is to create constants and a new function for assigning those constants to properties.


  1. Calling functions/subs is obsolete. Just do Sub argument, argument or x = function(argument)

  2. Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know. Right now you have nothing declared in your test module.

  3. Sub Test and Function test22222 tell me nothing about what they do. Name your procedures something useful - this may just be throw-away for you, but it's on code review, so by definition it's not.

  4. Function test22222(ByVal X As cTable) - why is this a function? It doesn't have a return type so it would be a sub instead.

  5. Naming, besides just being clear and concise, you should adhere to Standard VBA naming conventions - variables would be camelCase and only constants would be UPPER_CASE

Readability

'---------------------------------------------- DataRowStart'
Public Property Get DataRowStart() As Long
 DataRowStart = pDataRowStart
End Property
Public Property Let DataRowStart(Value As Long)
 pDataRowStart = Value
End Property
'---------------------------------------------- TableColStart'
Public Property Get TableColStart() As Long
 TableColStart = pTableColStart
End Property

You may think these headers make the code more clear, but it would actually be more clear without the clutter.

pHeaderRow = 1
pDataRowStart = 2
pTableColStart = 1

The usage of constants would be a good idea here

Const HEADER_ROW as Long = 1
Const DATA_ROW_START as Long = 2
Const TABLE_COLUMN_START as Long = 1

This moves it out of the initialization and makes it easier to see that they are constants when in use.

In your properties you use the variable value a lot. Try to make it more precise. Also, I avoid using variables named Value and Sheet because they are key words for the VBE.

cTable

So you've made a Class, that is great! They are sometimes difficult to start using because they seem so foreign (to many VBA writers). What I suggest is to think of this class as what it is - an object. That object then has properties.

For example, a Range is an object and it has properties like count and value.

Objects can also have methods. With Range you can do something complex like AutoFilter or something simple like clear

By remembering how VBA uses its object, you can build you own objects in the same way. This would suggest that if you feel you're overdoing it, and your object isn't that complex, then yes you are overdoing it.

Right now your class creates two objects - Dictionaries. Dictionaries are already objects (or classes) with properties and methods. Putting two of those into a single object means that your class is a collection. So then let's see if this collection of dictionaries would have some of these properties -

Header row, header names? Yes. Beginning rows and columns - I don't know, wouldn't that be a property of the source sheet? Speaking of the sheet - are both of these dictionaries always coming from the same sheet or file? If not, then maybe your class should be an object instead of a collection of objects.

Would a collection of dictionaries open a workbook? Probably not. That's probably something you'd want to do outside of the class, but that's just my opinion. There's no right or wrong here, just what you think makes sense. But, consider all the properties you didn't use in your test - why not? Because they aren't inherent to the object?

If pFileName - "" Then
Else
 HeaderName = ""

Instead of "" VBA has a constant for that - vbNullString. Always prefer that over empty quotes.

 With FromSht
 .Activate

No! Be sure to avoid things like .Activate - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on StackOverflow addressing this. If you know the target sheet, just use the target sheet.

Speaking of target sheet

Public Property Let HeaderRow(Value As Long)
 pHeaderLastCol = Cells(pHeaderRow, Columns.Count).End(xlToLeft).Column
 pHeaderRow = Value
End Property

This Cells is just assuming it needs to use the ActiveSheet. If you need to use a specific sheet, give that sheet a name. Either a variables or an actual name. Worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("mySheet") and instead just use mySheet.

Your formatting of the functions in the class is good - great usage of the line continuation _.

I know you mentioned you're new to Classes, and great job, but in this instance your dictionary is already an object, and I don't really see any properties or methods of the class that you don't just get from the dictionary. Also, as I already mentioned, this is sort of a collection anyway.

answered Aug 20, 2018 at 7:40
\$\endgroup\$
2
  • \$\begingroup\$ Regarding parameterized object creation, have a look at this blog post. Having successfully used this pattern myself, I'd call it possible. :) \$\endgroup\$ Commented Sep 19, 2018 at 9:15
  • \$\begingroup\$ I mean, I'm of the opinion that excel can pretty much do anything if you want it badly enough, but overloading isn't really possible - it turns into a workaround, which is great, but not great for non-advanced VBAers - lots of people haven't even used classes yet, you know. But thanks, good article, RD always is. \$\endgroup\$ Commented Sep 20, 2018 at 4:55

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.