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

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.