Locate Respective Column Header & Row ID based on Cell ID (e.g. A2, D15 etc)

Question

I have a code that will compare two datasets (Sheet 1, Sheet 2) and list the variances in Sheet 3.

I am trying to add three additional columns that will do a simple calculation and pull header/row info from Sheet 2.

• Deviation calculation: Dividing changed value by original value.
• Column Header will find header in column E
• Row ID will find ID in Row 2 (column A)

sample data sheet 1

Sheet 2 will look the same with different #s.

The output currently shows the cell ID where the variation was found, original and new value. The columns in yellow is what i am trying to add.

This is the original code:

Option Explicit

Sub ListChanges()
Dim x, y, z, i As Long, ii As Long

x = Original.Cells(1).CurrentRegion
y = Current.Cells(1).CurrentRegion
ReDim z(1 To 3, 1 To 1)

z(1, 1) = "Location": z(2, 1) = "Original Value": z(3, 1) = "Changed Value"
For i = 1 To UBound(y, 2)
    For ii = 2 To UBound(y, 1)
        If z(1, UBound(z, 2)) <> "" Then ReDim Preserve z(1 To 3, 1 To UBound(z, 2) + 1)
        If ii <= UBound(x, 1) Then

            If y(ii, i) <> x(ii, i) Then
                z(1, UBound(z, 2)) = Chr(64 + i) & ii
                z(2, UBound(z, 2)) = x(ii, i)
                z(3, UBound(z, 2)) = y(ii, i)
            End If
        Else
            z(1, UBound(z, 2)) = Chr(64 + i) & ii
            z(3, UBound(z, 2)) = y(ii, i)
        End If
    Next
Next
With Changes
    .Activate
    .Cells(1).CurrentRegion.Clear
    .[a1].Resize(UBound(z, 2), UBound(z, 1)) = Application.Transpose(z)
    With .Cells(1).CurrentRegion
        .HorizontalAlignment = xlCenter
        With Rows(1).Font
            .Size = 12
            .Bold = 1
        End With
        .Columns.AutoFit
    End With
End With

End Sub

I have been looking at different codes but the reference is usually a cell value where I am using the actual cell ID rather than its value.

Answer 1

Try something like this. Assumes rows may not be sorted the same, but columns are identical and in the same order.

Sub ListChanges()

    Dim arrOrig, arrCurrent, delta, i As Long, ii As Long, r As Long, m
    Dim rngOrig As Range, rngCurrent As Range, id, col As Long, vO, vC
    
    Set rngOrig = Original.Cells(1).CurrentRegion
    Set rngCurrent = Current.Cells(1).CurrentRegion
    
    arrOrig = rngOrig.Value
    arrCurrent = rngCurrent.Value
    
    ReDim delta(1 To UBound(arrCurrent, 1) * (UBound(arrCurrent, 2)), 1 To 6) 'max possible size
    
    delta(1, 1) = "Location"
    delta(1, 2) = "Original Value"
    delta(1, 3) = "Changed Value"
    delta(1, 4) = "Deviation"
    delta(1, 5) = "Header"
    delta(1, 6) = "Row ID"
    r = 1 'row in delta array
    
    For i = 2 To UBound(arrCurrent, 1)
        id = arrCurrent(i, 1)
        'find the corresponding row
        m = Application.Match(id, rngOrig.Columns(1), 0)
        If Not IsError(m) Then
            For col = 2 To UBound(arrCurrent, 2)
                vO = arrOrig(m, col)
                vC = arrCurrent(i, col)
                If (Len(vC) > 0 Or Len(vO) > 0) And vC <> vO Then
                    r = r + 1
                    delta(r, 1) = rngCurrent.Cells(i, col).Address(False, False)
                    delta(r, 2) = vO
                    delta(r, 3) = vC
                    If Len(vO) > 0 And Len(vC) > 0 Then
                        If IsNumeric(vO) And IsNumeric(vC) Then
                            delta(r, 4) = vC / vO * 100 'eg
                        End If
                    End If
                    delta(r, 5) = arrCurrent(1, col) 'header
                    delta(r, 6) = arrCurrent(i, 1)   'id
                End If
            Next col
        Else
            'no id match, just record the cell address and the current id
            r = r + 1
            delta(r, 1) = rngCurrent.Cells(i, 1).Address(False, False)
            delta(r, 6) = id
        End If
     Next
    With Changes
        .Activate
        .Cells(1).CurrentRegion.Clear
        .[a1].Resize(r, UBound(delta, 2)) = delta '<< edited here
        With .Cells(1).CurrentRegion
            .HorizontalAlignment = xlCenter
            With Rows(1).Font
                .Size = 12
                .Bold = 1
            End With
            .Columns.AutoFit
        End With
    End With

End Sub