Copy Columns Forward Macro: From Procedural to OOP

Question

Background: I had created a macro few years ago and when I was reviewing this now, it was hard to understand. I recently went through all the articles from RubberduckVBA and started learning that VBA can also be Object Oriented language and, I tried implementing this concept in my macro.

Purpose of Macro: we have new files every month, we add few columns at the end of the file and provide our comments. Again next month we used to pull comments using concat and vlookup but then I created a quick macro so it directly pulls all the data. It checks all the worksheets, compares with previous months file and pulls extra columns from old file.

Example: We have 8 columns in Sheet1 + 4 columns for comments. 12 column in Sheet2 + 5 columns of comments. The macro checks last column in current file and base don that dynamically copies last 4 and 5 columns in respective sheet based on the concatenated value of entire row in current/fresh file.

Note: I am copying entire range as we also have to pull number formatting, formula from the previous file.

Request: The macro works fine in both format, I would like to know what I missed or what can be updated in current version of the macro to make it more Object Oriented.

the following is the previous procedural Macro.

Option Explicit
Public Sub CarryForwardOld()
 'Declare and set variables
 'Add/check Tools> Reference> Microsoft Scripting Runtime
 Dim ReadingRange As String
 Dim dict As Scripting.Dictionary
 Set dict = New Scripting.Dictionary
 'Set screenupdating to false to increase the speed of processing
 'Application.Calculation = xlCalculationAutomatic
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
 Application.EnableCancelKey = xlInterrupt
 Dim wbCurrent As Workbook
 Set wbCurrent = ActiveWorkbook
 Dim getfile As String
 getfile = selectedfile(wbCurrent.Name)
 
 If getfile = vbNullString Then Exit Sub
 Dim wbOld As Workbook
 Set wbOld = Workbooks(getfile)
 
 If Not wbOld Is Nothing Then
 If wbOld.Name = wbCurrent.Name Then
 MsgBox "Both file names canot be same! System cannot distinguish between old and new file.", vbCritical, "Rename Either of the File"
 Exit Sub
 End If
 End If
 
 wbCurrent.Activate
 Dim rOld As Long
 Dim rNew As Long
 rOld = 0
 rNew = 0
 
 Dim index As Long
 index = 0
 Dim wsOld As Worksheet
 Dim wsCurr As Worksheet
 
 Dim LastColumnWrite As Long
 Dim WritingRow As Long
 Dim LastRowCurrent As Long
 Dim LastRowOld As Long
 Dim LastColumnCurrent As Long
 Dim LastColumnOld As Long
 Dim readingrow As Long
 For Each wsOld In wbOld.Sheets
 
 On Error Resume Next
 Set wsCurr = wbCurrent.Sheets(wsOld.Name)
 On Error GoTo 0
 
 If Not wsCurr Is Nothing Then
 
 LastColumnCurrent = GetLasts(wsCurr, "Column") - index
 LastRowCurrent = GetLasts(wsCurr, "Row")
 LastRowOld = GetLasts(wsOld, "Row")
 LastColumnOld = GetLasts(wsOld, "Column")
 LastColumnWrite = GetLasts(wsCurr, "Column")
 
 wsOld.Activate
 
 For readingrow = 1 To LastRowOld
 
 With wsOld
 On Error Resume Next
 Dim AddValue As String
 AddValue = Concat(.Range(.Cells(readingrow, 1), .Cells(readingrow, LastColumnCurrent)))
 
 If Not dict.Exists(AddValue) Then
 dict.Add key:=AddValue, _
 Item:=.Range(.Cells(readingrow, LastColumnCurrent + 1), .Cells(readingrow, LastColumnOld)).Address
 End If
 On Error GoTo 0
 End With
 
 Application.StatusBar = "Reading row " & readingrow & " out of " & LastRowOld
 Next readingrow
 
 Application.StatusBar = False
 wsCurr.Activate
 
 For WritingRow = 1 To LastRowCurrent
 Application.StatusBar = "Writing row in Sheet: " & wsCurr.Name & "=>" & WritingRow & " out of " & LastRowCurrent
 ReadingRange = Concat(wsCurr.Range(wsCurr.Cells(WritingRow, 1), wsCurr.Cells(WritingRow, LastColumnCurrent)))
 Dim writeRange As Range
 If dict.Exists(ReadingRange) = True Then
 Set writeRange = wsOld.Range(dict(ReadingRange))
 'wsCurr.Range(Cells(WritingRow, LastColumnWrite + 1), Cells(WritingRow, LastColumnOld)) = Split(Dict(ReadingRange), "|")
 writeRange.Copy wsCurr.Range(wsCurr.Cells(WritingRow, LastColumnWrite + 1), wsCurr.Cells(WritingRow, LastColumnWrite + 1))
 rOld = rOld + 1
 Else
 Dim outRange As Range
 Set outRange = wsCurr.Range(wsCurr.Cells(WritingRow, LastColumnWrite + 1), wsCurr.Cells(WritingRow, LastColumnOld))
 
 Dim cell As Range
 outRange.Interior.colorindex = 36
 For Each cell In outRange
 If cell.Row = 1 Then GoTo nextcell:
 If cell.Offset(-1, 0).HasFormula Then
 cell.Interior.colorindex = -4142
 cell.FillDown
 
 End If
nextcell:
 Next cell
 
 'wsCurr.Range(wsCurr.Cells(WritingRow, LastColumnWrite + 1), wsCurr.Cells(WritingRow, LastColumnOld)).Interior.ColorIndex = 36
 'wsCurr.Cells(WritingRow, LastColumnWrite + 1) = ReadingRange
 rNew = rNew + 1
 End If
 Next WritingRow
 
 End If
 Next wsOld
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 wbOld.Close False
 Set wbOld = Nothing
 Application.StatusBar = False
 MsgBox "There are " & rNew & " new records and " & rOld & " old records!", vbOKOnly, "Success!"
End Sub
Public Function GetLasts(ByVal TargetWorksheet As Worksheet, ByRef RowColum As String) As Long
 If Not TargetWorksheet Is Nothing Then
 With TargetWorksheet
 Select Case True
 Case Left$(RowColum, 1) = "R"
 On Error Resume Next
 GetLasts = .Cells.Find(What:="*", _
 after:=.Range("A1"), _
 Lookat:=xlPart, _
 LookIn:=xlFormulas, _
 SearchOrder:=xlByRows, _
 SearchDirection:=xlPrevious, _
 MatchCase:=False).Row
 On Error GoTo 0
 
 Case Left$(RowColum, 1) = "C"
 On Error Resume Next
 GetLasts = .Cells.Find(What:="*", _
 after:=.Range("A1"), _
 Lookat:=xlPart, _
 LookIn:=xlFormulas, _
 SearchOrder:=xlByColumns, _
 SearchDirection:=xlPrevious, _
 MatchCase:=False).Column
 On Error GoTo 0
 End Select
 End With
 End If
End Function
Private Function selectedfile(Optional ByVal CurrentFile As String = vbNullString) As String
 On Error GoTo ErrorHandler
 Dim dialog As FileDialog
 Set dialog = Application.FileDialog(msoFileDialogFilePicker)
 With dialog
 .AllowMultiSelect = False
 .InitialFileName = GetSetting("Office1", "CarryForward", "LastPath")
 .Title = "Select Old/Previous file for reference: " & CurrentFile
 .Show
 If .SelectedItems.Count <> 0 Then
 selectedfile = .SelectedItems.Item(1)
 SaveSetting "Office1", "CarryForward", "LastPath", selectedfile
 Workbooks.Open FileName:=selectedfile
 selectedfile = Mid$(selectedfile, InStrRev(selectedfile, "\") + 1)
 
 End If
 End With
 If selectedfile = vbNullString Then
 MsgBox "You cancelled the prcess!", vbOKOnly, "Alert!"
 Exit Function
 End If
 Exit Function
ErrorHandler:
 If Err.Number > 0 Then 'TODO: handle specific error
 Err.Clear
 Resume Next
 End If
End Function
Private Function Concat(ByVal ConcatRange As Range) As String
 Dim cell As Variant
 Dim delim As String
 delim = "|"
 Dim Result As String
 Result = vbNullString
 Dim CellArray As Variant
 If ConcatRange.Cells.Count > 1 Then
 CellArray = Application.WorksheetFunction.Transpose(ConcatRange.Value)
 
 Else
 Concat = ConcatRange.Value
 Exit Function
 End If
 For Each cell In CellArray
 
 If IsError(cell) Then
 Dim errstring As String
 Dim errval As Variant
 errval = cell
 
 Select Case errval
 Case CVErr(xlErrDiv0)
 errstring = "#DIV"
 Case CVErr(xlErrNA)
 errstring = "#N/A"
 Case CVErr(xlErrName)
 errstring = "#NAME"
 Case CVErr(xlErrNull)
 errstring = "#NULL"
 Case CVErr(xlErrNum)
 errstring = "#NUM"
 Case CVErr(xlErrRef)
 errstring = "#REF"
 Case CVErr(xlErrValue)
 errstring = "#VALUE"
 Case Else
 errstring = vbNullString
 End Select
 
 Result = Result & delim & errstring
 Else
 Result = Result & delim & cell
 End If
 Next cell
 Concat = Right$(Result, Len(Result) - 1)
End Function

The following is the class module implementing Object Orientation.

Class: CarryMe.cls

 Option Explicit
Private Type TCell
 Book As Workbook
 Sheet As Worksheet
 LastRow As Long
 LastColumn As Long
 Records As Long
End Type
Private Previous As TCell
Private Current As TCell
'Add/check Tools> Reference> Microsoft Scripting Runtime
Private dict As Scripting.Dictionary
Public Sub Execute()
 'Set screenupdating to false to increase the speed of processing
 With Application
 '.Calculation = xlCalculationAutomatic
 .Calculation = xlCalculationManual
 .ScreenUpdating = False
 .EnableCancelKey = xlInterrupt
 End With
 
 SelectPreviousFile
 
 If Previous.Book Is Nothing Then Exit Sub
 Dim wsheet As Worksheet
 For Each wsheet In Current.Book.Sheets
 
 SetParameters wsheet.Name
 
 ReadDataToDictionary
 
 WriteDictToSheet
 
 Next wsheet
 
 Previous.Book.Close False
 Set Previous.Book = Nothing
 With Application
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
 .StatusBar = False
 End With
 
 MsgBox "There are " & Current.Records & " new records and " & Previous.Records & " old records!", vbOKOnly, "Success!"
End Sub
Private Sub SetParameters(ByVal SheetName As String)
 Set Current.Sheet = Current.Book.Sheets(SheetName)
 Set Previous.Sheet = Previous.Book.Sheets(SheetName)
 
 With Current.Sheet
 Current.LastRow = .Cells.Find(What:="*", after:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
 Current.LastColumn = .Cells.Find(What:="*", after:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
 End With
 
 If Previous.Sheet Is Nothing Then Exit Sub
 
 With Previous.Sheet
 Previous.LastRow = .Cells.Find(What:="*", after:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
 Previous.LastColumn = .Cells.Find(What:="*", after:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
 End With
End Sub
Private Sub ReadDataToDictionary()
 Set dict = New Scripting.Dictionary
 
 With Previous.Sheet
 
 Dim index As Long
 
 For index = 1 To Previous.LastRow
 On Error Resume Next
 Dim AddValue As String
 AddValue = Concat(.Range(.Cells(index, 1), .Cells(index, Current.LastColumn)))
 
 If Not dict.Exists(AddValue) Then
 dict.Add key:=AddValue, _
 Item:=.Range(.Cells(index, Current.LastColumn + 1), .Cells(index, Previous.LastColumn)).Address
 End If
 On Error GoTo 0
 Next index
 End With
End Sub
Private Sub WriteDictToSheet()
 With Current.Sheet
 
 Dim index As Long
 
 For index = 1 To Current.LastRow
 Application.StatusBar = "Writing row in Sheet: " & Current.Sheet.Name & "=>" & index & " out of " & Current.LastRow
 
 Dim ReadingRange As String
 ReadingRange = Concat(.Range(.Cells(index, 1), .Cells(index, Current.LastColumn)))
 
 If dict.Exists(ReadingRange) Then
 Dim writeRange As Range
 Set writeRange = Previous.Sheet.Range(dict(ReadingRange))
 
 writeRange.Copy .Range(.Cells(index, Current.LastColumn + 1), .Cells(index, Previous.LastColumn + 1))
 Previous.Records = Previous.Records + 1
 Else
 Dim outRange As Range
 Set outRange = .Range(.Cells(index, Current.LastColumn + 1), .Cells(index, Previous.LastColumn))
 
 Dim cell As Range
 outRange.Interior.colorindex = 36
 For Each cell In outRange
 If cell.Row = 1 Then GoTo nextcell:
 If cell.Offset(-1, 0).HasFormula Then
 cell.Interior.colorindex = -4142
 cell.FillDown
 End If
nextcell:
 Next cell
 
 Current.Records = Current.Records + 1
 End If
 Next index
 End With
End Sub
Private Sub SelectPreviousFile()
 On Error GoTo ErrorHandler
 Dim dialog As FileDialog
 Set dialog = Application.FileDialog(msoFileDialogFilePicker)
 With dialog
 .AllowMultiSelect = False
 .InitialFileName = GetSetting("Office1", "CarryForward", "LastPath")
 .Title = "Select Old/Previous file for reference: " & Current.Book.Name
 .Show
 If .SelectedItems.Count <> 0 Then
 Dim selectedfile As String
 selectedfile = .SelectedItems.Item(1)
 SaveSetting "Office1", "CarryForward", "LastPath", selectedfile
 Workbooks.Open FileName:=selectedfile
 selectedfile = Mid$(selectedfile, InStrRev(selectedfile, "\") + 1)
 
 End If
 End With
 Select Case True
 Case selectedfile = vbNullString
 MsgBox "You cancelled the prcess!", vbOKOnly, "Alert!"
 
 Case selectedfile = Current.Book.Name
 MsgBox "Both file names canot be same! System cannot distinguish between old and new file.", vbCritical, "Rename Either of the File"
 
 Case Else
 Set Previous.Book = Workbooks(selectedfile)
 End Select
 
 Exit Sub
ErrorHandler:
 If Err.Number > 0 Then 'TODO: handle specific error
 Err.Clear
 Resume Next
 End If
End Sub
Private Function Concat(ByVal ConcatRange As Range) As String
 Dim cell As Variant
 Dim delim As String
 delim = "|"
 Dim Result As String
 Result = vbNullString
 Dim CellArray As Variant
 If ConcatRange.Cells.Count > 1 Then
 CellArray = Application.WorksheetFunction.Transpose(ConcatRange.Value)
 
 Else
 Concat = ConcatRange.Value
 Exit Function
 End If
 For Each cell In CellArray
 
 If IsError(cell) Then
 Dim errstring As String
 Dim errval As Variant
 errval = cell
 
 Select Case errval
 Case CVErr(xlErrDiv0)
 errstring = "#DIV"
 Case CVErr(xlErrNA)
 errstring = "#N/A"
 Case CVErr(xlErrName)
 errstring = "#NAME"
 Case CVErr(xlErrNull)
 errstring = "#NULL"
 Case CVErr(xlErrNum)
 errstring = "#NUM"
 Case CVErr(xlErrRef)
 errstring = "#REF"
 Case CVErr(xlErrValue)
 errstring = "#VALUE"
 Case Else
 errstring = vbNullString
 End Select
 
 Result = Result & delim & errstring
 Else
 Result = Result & delim & cell
 End If
 Next cell
 Concat = Right$(Result, Len(Result) - 1)
End Function
Private Sub Class_Initialize()
 Set Current.Book = ActiveWorkbook
 Set Previous.Sheet = Nothing
 Set Current.Sheet = Nothing
End Sub

Usage: Following the code that I use to initiate the class and use macro.

Module: TempModule.bas

Public Sub TestingCarryClass()
Dim CarryForward As CarryMe
Set CarryForward = New CarryMe
CarryForward.Execute
End Sub

• Mathieu Guindon: Good stuff! Thanks for reading all my ramblings!
• Vipul Karkar: Thank you @MathieuGuindon for all your contributions. I had created hundreds of Macro and UDFs and I am now refactoring and updating all the codes using rubberduck VBA add-in, started learning OOP, SOLID principle and I cannot tell you how much happy I am discovering all these concepts that I never knew in my entire life. It's been more than 7 years and I am planning to refactor more than 30k lines of code. Thank you once again!
• Mathieu Guindon: You are on the very site that taught me all these things, I hope you stick around!
• Vipul Karkar: Yes, I never knew about code reviews, while searching for a OOP, I found out about this code review meta and then after exploring questions, the battleship game was the turning point for me, I came to know about your blog and then add-in and other helpful resources and now I am with the flow of exploring the entire new universe of OOP. Thank you and the RubberduckVBA add-in team for all your contributions to community.

Answer 1

The OOP version of the code generated some thoughts around separation of concerns: user interactions and data processing.

Single Responsibility Principle(SRP):

Every module, class or function in a computer program should have responsibility over a single part of that program's functionality, and it should encapsulate that part.

SRP would encourage identifying user interactions and data processing as two responsibilities.

So, considering to the OOP version of CarryForwardOld, there are two modules: TempModule and CarryMe.

TempModule clearly does one thing:

It is the Entry Point to the operation to be performed. Once the Entry Point is called it delegates all work to Class Module.CarryMe for processing.

CarryMe however, does more that one 'thing':

1. Requests user interactions to select the 'Previous' file and to acknowledge success of the process.
2. Modifies a 'Current' workbook based on data in a 'Previous' workbook to carry forward the data.

So, a reasonable improvement to the CarryMe class would be to allow it to be tested free of human interaction. Currently, a user must select the source workbook. Also, at the end of calling Execute, the user receives a pop-up message that requires acknowledgement. Either of these user interactions eliminate the option for using a code-only test client.

CarryMe requires two Workbook objects (Previous and Current) to operate on. However, there is no reason that theCarryMe class needs to take responsibility for getting the workbooks. Further, to accomplish its task, the CarryMe class does not need to be responsible for indicating success with a pop-up message. By extracting the user interaction code from CarryMe, CarryMe.Execute can be unit tested.

So, rather than exposing a parameterless subroutine (CarryMe.Execute) to accomplish the task, one could expose a function that takes two Workbook parameters and returns True if successful (and False if it fails).

Using a Boolean returning function is a typical pattern that provides a 'safe' way to attempt an operation that could possibly fail. The pattern/function guarantees that it will return a pass/fail result rather than causing an exception or returning an error code. The functions are typically prefaced with Try and can either attempt an operation or attempt to retrieve a value/object. Either way, the 'TryXXXX' pattern relieves the calling code from having to catch an exception or evaluate error return codes.

Below, the Execute subroutine has been modified to a Boolean returning function TryExecute:

 Public Function TryExecute(ByVal currentWrkbk As Workbook, ByVal previousWrkbk As Workbook) As Boolean
 
 'TryExecute wraps the operation with error handling to guarantee Excel 
 'Application settings are reset.
 'Note: The original Execute() version has a bug in that these settings are not reset if a 
 'Previous' workbook is not selected by the user.
 If previousWrkbk Is Nothing Then Exit Function
 
 TryExecute = False 'will be set to True if the code succeeds
 On Error GoTo ErrorExit:
 With Application
 .Calculation = xlCalculationManual
 .ScreenUpdating = False
 .EnableCancelKey = xlInterrupt
 End With
 Set Current.Book = currentWorkbook
 Set Previous.Book = previousWrkbk
 
 Dim wsheet As Worksheet
 For Each wsheet In Current.Book.Sheets
 
 SetParameters wsheet.Name
 ReadDataToDictionary
 WriteDictToSheet
 
 Next wsheet
 
 TryExecute = True
 ErrorExit:
 With Application
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
 .StatusBar = False
 End With
 
 End Function

For automated testing (no user interaction), a test module could test TryExecute with code like:

 Public Function CarryForwardTryExecuteTest() As Boolean
 Dim previousWorkbook as Workbook
 Dim previousWorkbookPath As String
 previousWorkbookPath = <Filepath to a test 'previous' workbook>
 Set previousWorkbook = Workbooks.Open(previousWorkbookPath)
 Dim currentWorkbook as Workbook
 Dim currentWorkbookPath As String
 currentWorkbookPath = <Filepath to a test 'current' workbook>
 Set currentWorkbook = Workbooks.Open(currentWorkbookPath )
 
 Dim CarryForward As CarryMe
 Set CarryForward = New CarryMe
 CarryForwardTryExecuteTest= CarryForward.TryExecute(currentWorkbook, previousWorkbook) Then
 End Function

So, where should the extracted user interactions be handled? The module TempModule, which is invoked by a user, is a candidate to handle the user interactions. If it can be assumed that TempModule.TestingCarryClass can only be invoked by a user, then it is reasonable to support user interactions from TempModule. Otherwise, add another module and EntryPoint to be responsible for the user-initiated processes.

So, if TempModule handles the user interactions, it would look like:

 Option Explicit
 Public Sub TestingCarryClass()
 Dim previousWorkbook As Workbook
 Set previousWorkbook = SelectPreviousFile()
 
 If previousWorkbook Is Nothing Then
 Exit Sub
 End If
 
 Dim CarryForward As CarryMe
 Set CarryForward = New CarryMe
 'Note the addition of Properties CurrentRecordCount and PreviousRecordCount
 'to CarryMe
 If CarryForward.TryExecute(Application.ActiveWorkbook, previousWorkbook) Then
 MsgBox "There are " & CarryForward.CurrentRecordCount & " new records and " & CarryForward.PreviousRecordCount & " old records!", vbOKOnly, "Success!"
 Exit Sub
 End If
 
 MsgBox "Unexpected Error"
 End Sub
 'Note: unchanged
 Private Function SelectPreviousFile() As Workbook
 
 Set SelectPreviousFile = Nothing
 
 On Error GoTo ErrorHandler
 Dim dialog As FileDialog
 Set dialog = Application.FileDialog(msoFileDialogFilePicker)
 With dialog
 .AllowMultiSelect = False
 .InitialFileName = GetSetting("Office1", "CarryForward", "LastPath")
 .Title = "Select Old/Previous file for reference: " & Current.Book.Name
 .Show
 If .SelectedItems.Count <> 0 Then
 Dim selectedfile As String
 selectedfile = .SelectedItems.Item(1)
 SaveSetting "Office1", "CarryForward", "LastPath", selectedfile
 Workbooks.Open Filename:=selectedfile
 selectedfile = Mid$(selectedfile, InStrRev(selectedfile, "\") + 1)
 
 End If
 End With
 Select Case True
 Case selectedfile = vbNullString
 MsgBox "You cancelled the prcess!", vbOKOnly, "Alert!"
 
 Case selectedfile = ActiveWorkbook.Name 'Current.Book.Name
 MsgBox "Both file names canot be same! System cannot distinguish between old and new file.", vbCritical, "Rename Either of the File"
 
 Case Else
 'Set Previous.Book = Workbooks(selectedfile)
 Set SelectPreviousFile = Workbooks(selectedfile)
 End Select
 
 Exit Function
 ErrorHandler:
 If Err.Number > 0 Then 'TODO: handle specific error
 Err.Clear
 Resume Next
 End If
 End Function

Extracting user interface responsibilities from the CarryMe class allows it to focus on workbook processing (a single responsibility) with UI responsibilities handled by TempModule. And...CarryMe.TryExecute can now be unit tested.

• Vipul Karkar: Thank you so much for the inputs, I started implementing this using the command pattern from rubberduckvba (rubberduckvba.wordpress.com/2020/11/19/…) but didn't realize that for testing purpose I have to keep user interaction separated from the other functionality. Quick Question: the class should have only function exposed to client code, right? which accepts 2 workbooks and returns Boolean value. I think I missed the testing part and I have to work on making my codes more test friendly. Thanks again for the thoughts.
• Vipul Karkar: As there's no more suggestions, I accepted your answer and will see if someone comes up with more suggestions. :)