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
\$\endgroup\$
  • \$\begingroup\$ There seem to be some leftover formatting issue, can you verify your code? Nexti: Next i End Function \$\endgroup\$ – Ludisposed Aug 17 '18 at 7:20
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.

\$\endgroup\$
  • \$\begingroup\$ Regarding parameterized object creation, have a look at this blog post. Having successfully used this pattern myself, I'd call it possible. :) \$\endgroup\$ – Inarion Sep 19 '18 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\$ – Raystafarian Sep 20 '18 at 4:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.