Storing cell addresses into an array in vba while using a loop

Question

I am trying to work through a code that utilizes a system to check two different worksheets by using a for loop and highlight the differences/edits made in the second sheet ("Version 2") onto the first sheet ("Original"). I have a feeling that I need to utilize an array but I'm not advanced enough where I know how to store the values and then later write them onto another sheet (down below).

I've gotten the code so that it highlights all the relevant cells, but now I'm trying to output it into a report (on another sheet called 'Logged Changes') which will summarize all the cell addresses where edits were made. Please forgive all the variables as this is from an old code set where variables are not explicitly defined:

Private Sub CompareBasic()
Dim actSheet As Range
Dim k As Integer
Dim o As Long
Dim p As Long
Dim i As Integer
Dim change As Integer

o = Worksheets("Original").Cells(2, Columns.Count).End(xlToLeft).Column
p = Worksheets("Original").Range("A" & Rows.Count).End(xlUp).Row
change = 0

Sheets("Original").Select
    
For i = 2 To p
    For k = 1 To o
        If IsNumeric(Worksheets("Original").Cells(i, k).Value) = True Then
            If Worksheets("Original").Cells(i, k).Value <> Worksheets("Version 2").Cells(i, k).Value Then
                Worksheets("Original").Cells(i, k).Interior.ColorIndex = 37
                change = change + 1
            End If
        Else
            If StrComp(Worksheets("Original").Cells(i, k), Worksheets("Version 2").Cells(i, k), vbBinaryCompare) <> 0 Then
                Worksheets("Original").Cells(i, k).Interior.ColorIndex = 37
                change = change + 1
            End If
        End If
    Next k
Next i
Unload Me
MsgBox "Number of cells edited counted: " & change, vbOKOnly + vbExclamation, "Summary"
b = Empty

answer = MsgBox("Do you want to run the Report?", vbYesNo + vbQuestion)

If answer = vbYes Then
    If Sheet_Exists("Logged Changes") = False Then
        Sheet_Name = "Logged Changes"
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = Sheet_Name
    End If
    Worksheets("Logged Changes").Range("A1") = "Edited Requirements"
Else
    Unload Me
End If
End Sub

I have tried fiddling around with the code, but didn't want to clog it up with any unnecessary/broken lines. Any help would be greatly appreciated!

Answer 1

Sheet Differences

Option Explicit

Sub logChanges()

    Const ws1Name As String = "Original"
    Const ws2Name As String = "Version 2"
    Const wsResult As String = "Logged Changes"
    Const FirstRow As Long = 2
    Const FirstColumn As Long = 1
    Const LastRowColumn As Long = 1
    Const LastColumnRow As Long = 2
    Const ResultFirstCell As String = "A2"
    Dim Headers As Variant
    Headers = Array("Id", "Address", "Original", "Version 2")
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(ws1Name)
    
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, LastRowColumn).End(xlUp).Row
    Dim LastColumn As Long
    LastColumn = ws.Cells(LastColumnRow, ws.Columns.Count) _
                    .End(xlToLeft).Column
    
    Dim rng As Range
    Set rng = ws.Range(ws.Cells(FirstRow, FirstColumn), _
                        ws.Cells(LastRow, LastColumn))
    Dim Data1 As Variant: Data1 = rng.Value
    
    Set ws = wb.Worksheets(ws2Name)
    Dim Data2 As Variant: Data2 = ws.Range(rng.Address).Value
    
    Dim Result() As Variant
    Dim i As Long, j As Long, k As Long
    For i = 1 To UBound(Data1)
        For j = 1 To UBound(Data1, 2)
            If Data1(i, j) <> Data2(i, j) Then GoSub writeResult
        Next j
    Next i
    
    If k > 0 Then
        transpose2D Result
        On Error GoTo MissingResultSheet
        Set ws = wb.Worksheets(wsResult)
        On Error GoTo 0
        ws.Range(ws.Range(ResultFirstCell), _
                 ws.Cells(ws.Rows.Count, ws.Columns.Count)).Clear
        ws.Range(ResultFirstCell).Resize(k, UBound(Result, 2)).Value = Result
        MsgBox "Found '" & k & "' difference(s) in range '" _
          & rng.Address(False, False) & "'.", vbInformation
    Else
        MsgBox "Found no differences in range '" _
          & rng.Address(False, False) & "'.", vbExclamation
    End If
    
    Exit Sub
    
writeResult:
    k = k + 1
    ReDim Preserve Result(1 To 4, 1 To k)
    Result(1, k) = k
    Result(2, k) = getAddress(i + FirstRow - 1, j + FirstColumn - 1)
    Result(3, k) = Data1(i, j)
    Result(4, k) = Data2(i, j)
    Return

MissingResultSheet:
    If Err.Number = 9 Then
        wb.Worksheets.Add After:=wb.Sheets(wb.Sheets.Count)
        With ActiveSheet
            .Name = wsResult
            If .Range(ResultFirstCell).Row > 1 Then
               .Range(ResultFirstCell).Offset(-1) _
                 .Resize(, UBound(Headers) + 1).Value = Headers
            End If
        End With
        Resume ' i.e. the code continues with Set ws = wb.Worksheets(wsResult)
    Else
        '?
        Exit Sub
    End If

End Sub

Function getAddress(aRow As Long, aColumn As Long) As String
    getAddress = ActiveSheet.Cells(aRow, aColumn).Address(False, False)
End Function

Sub transpose2D(ByRef Data As Variant)
    Dim i As Long, j As Long
    Dim Result As Variant
    ReDim Result(LBound(Data, 2) To UBound(Data, 2), _
                 LBound(Data) To UBound(Data))
    For i = LBound(Data) To UBound(Data)
        For j = LBound(Data, 2) To UBound(Data, 2)
            Result(j, i) = Data(i, j)
        Next j
    Next i
    Data = Result
End Sub

This solution for converting a column number to a string without using objects Function to convert column number to letter? could be used to write a descent getAddress function.

Answer 2

Try this:

Option Explicit

Private Sub CompareBasic()
    Const SHT_REPORT As String = "Logged Changes"
    Dim actSheet As Range
    Dim c As Integer
    Dim o As Long
    Dim p As Long
    Dim r As Long
    Dim change As Long, wsOrig As Worksheet, wsNew As Worksheet, wsReport As Worksheet
    Dim dataOrig, dataNew, rngData As Range, v1, v2, bDiff As Boolean
    Dim arrUpdates
    
    Set wsOrig = Worksheets("Original")
    Set wsNew = Worksheets("Version 2")
    
    o = wsOrig.Cells(2, Columns.Count).End(xlToLeft).Column
    p = wsOrig.Range("A" & Rows.Count).End(xlUp).Row
    
    Set rngData = wsOrig.Range("A2", wsOrig.Cells(p, o))
    dataOrig = rngData.Value                           'get an array of data
    dataNew = wsNew.Range(rngData.Address).Value       'array of new data
    ReDim arrUpdates(1 To rngData.Cells.Count, 1 To 3) 'for change info
    change = 0
    
    For r = 1 To UBound(dataOrig, 1)
        For c = 1 To UBound(dataOrig, 2)
            v1 = dataOrig(r, c)
            v2 = dataNew(r, c)
            If Len(v1) > 0 Or Len(v2) > 0 Then
                If IsNumeric(v1) Then
                    bDiff = v1 <> v2
                Else
                    bDiff = StrComp(v1, v2, vbBinaryCompare) <> 0
                End If
            End If
            'any difference?
            If bDiff Then
                change = change + 1
                With rngData.Cells(r, c)
                    arrUpdates(change, 1) = .Address
                    .Interior.ColorIndex = 37
                End With
                arrUpdates(change, 2) = v1
                arrUpdates(change, 3) = v2
            End If
        Next c
    Next r
    
    If MsgBox("Do you want to run the Report?", vbYesNo + vbQuestion) = vbYes Then
        With GetSheet(SHT_REPORT, ThisWorkbook)
            .UsedRange.ClearContents
            .Range("A1") = "Edited Requirements"
            .Range("A3").Resize(1, 3).Value = Array("Address", wsOrig.Name, wsNew.Name)
            .Range("A4").Resize(change, 3).Value = arrUpdates
        End With
    Else
        'Unload Me
    End If
End Sub

'return as sheet from wb by name (and create it if it doesn't exist)
Function GetSheet(wsName, wb As Workbook) As Worksheet
    Dim rv As Worksheet
    On Error Resume Next
    Set rv = wb.Worksheets(wsName)
    On Error GoTo 0
    If rv Is Nothing Then
        Set rv = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
        rv.Name = "Logged Changes"
    End If
    Set GetSheet = rv
End Function