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.
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?
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
Nexti: Next i End Function
\$\endgroup\$