Comparing two sets of multiple columns on two separate sheets and updating differences

[ujambor]

Hi

I am having some serious problems with setting up a "double" array (cells in a row A:H and K:V) as a search variable.

Background:
My DATA sheet has some 50.000 lines and more (columns from A to K). I am splitting this table in multiple small files for specific users. After a while I collect the data back to my master file to sheet TEMP. Each row on sheet TEMP is unique within A:H range (as they originated from sheet DATA) and exactly the same unique row is available somewhere on sheet DATA. Only difference is in:

• same unique array of cells in a row on sheet DATA is not in a same row as on sheet TEMP (these cells are never modified by end users) and
• values in range K:V may be different - these are regularly modified by end users

My Christmas wish is:
that someone helps me set up a code, that:

1. sets up an array variant of each unique array A:H and corresponding K:V array from the same line on sheet TEMP,
2. searches for same unique array A:H on sheet DATA,
3. checks if there is any difference between K:V array on TEMP and DATA sheets
4. updates K:V array on sheet DATA if it is not the same as K:V array from sheet TEMP

I did find two threads below, but I am truly short in understanding many basics in setting up array variables and then comparing these variables. I have cracked up some code for easier undestanding (below).
https://www.mrexcel.com/forum/excel-questions/484914-macro-adjustment-compare-two-sheets-2.html?highlight=excel+array+variant
https://www.mrexcel.com/forum/excel...olumns-display-differences-using-macro-2.html

Sub SyncMasterSheet()

Dim i As Long
Dim j As Long
i = 1
j = 1

'sheets set up
    Dim SheetDATA As Worksheet
    Dim SheetTEMP As Worksheet
    Set SheetDATA = Worksheets("DATA")
    Set SheetTEMP = Worksheets("TEMP")

'last row setup
    Dim LastRowDATA As Long
    Dim LastRowTEMP As Long
    With SheetDATA
        LastRowDATA = .Cells(.rows.Count, "A").End(xlUp).row
    End With
    With SheetTEMP
        LastRowTEMP = .Cells(.rows.Count, "A").End(xlUp).row
    End With

'full range setup
    'Dim RangeDATA As Range
    'Dim RangeTEMP As Range
    'Set RangeDATA = SheetTEMP.Range(Cells(2, 1), Cells(LastRowDATA, 8))
    'Set RangeTEMP = SheetTEMP.Range(Cells(2, 1), Cells(LastRowTEMP, 8))
    Dim RangeDATA As Variant
    Dim RangeTEMP As Variant
    RangeDATA = SheetTEMP.Range(Cells(2, 1), Cells(LastRowDATA, 8))
    RangeTEMP = SheetTEMP.Range(Cells(2, 1), Cells(LastRowTEMP, 8))

With SheetTEMP
    For i = 2 To LastRowTEMP
        Dim TEMPsearchARRAY1 As Variant
        Dim TEMPsearchARRAY2 As Variant
        TEMPsearchARRAY1 = Application.Range(Cell1:="TEMP!A" & i & ":" & "H" & i) 'this set of cells defines unique row entry and are fixed - no changes here
        TEMPsearchARRAY2 = Application.Range(Cell1:="TEMP!K" & i & ":" & "V" & i) 'these cells are being constantly changed by users
        
        With SheetDATA
            For j = 2 To LastRowDATA
                Dim DATArowNUMBER As Long
                Dim DATAsearchARRAY1 As Variant
                Dim DATAsearchARRAY2 As Variant
                    DATAsearchARRAY1 = Application.Range(Cell1:="DATA!A" & i & ":" & "H" & i) 'this set of cells defines unique row entry and are fixed
                                                                                                                         'no changes here (same on DATA and TEMP sheets)
                    Set DATAsearchARRAY1 = RangeDATA.Find(What:=TEMPsearchARRAY1, _
                                                    LookIn:=xlValues, _
                                                    LookAt:=xlWhole, _
                                                    SearchOrder:=xlByRows, _
                                                    SearchDirection:=xlNext, _
                                                    MatchCase:=False)
                    DATArowNUMBER = DATAsearchARRAY1.row

                    DATAsearchARRAY2 = Application.Range(Cell1:="DATA!K" & DATArowNUMBER & ":" & "V" & DATArowNUMBER) 'this is a point where if TEMPsearchARRAY2
                                                                                                                                                                     'is different than DATAsearchARRAY2
                                                                                                                                                                     'then TEMPsearchARRAY2 should replace DATAsearchARRAY2
                    If DATAsearchARRAY2 <> TEMPsearchARRAY2 Then
                        DATAsearchARRAY2 = TEMPsearchARRAY2
                    End If
            Next j
        End With
        
    Next i
End With

Please help, thank you!

 

[al_b_cnu]

Hi ujambor, try this code:

Option Explicit

Const msKeyColStart As String = "A"
Const msKeyColEnd As String = "H"
Const msDataColStart As String = "K"
Const msDataColEnd As String = "V"

Const msDataSheet As String = "DATA"
Const msAmendmentsSheet As String = "TEMP"

Dim mlStartKeyCol As Long
Dim mlEndKeyCol As Long
Dim mlDataStartCol As Long
Dim mlDataEndCol As Long

Sub SyncMasterSheet()

Dim bRowChanged As Boolean

Dim dicAmendments As Object

Dim lDataRowPtr As Long
Dim lAmendRowPtr As Long
Dim lEndRow As Long
Dim lEndDataRow As Long
Dim lChangesCount As Long
Dim lReportChangeRow As Long
Dim lReportInterval As Long

Dim lCellsChangedCount As Long
Dim lCellsChangedCountCur As Long
Dim lRowsAddedCount As Long
Dim lColPtr As Long

Dim sMessage As String

Dim vCurDataKey As Variant
Dim vaData As Variant
Dim vaAmendments As Variant
Dim vKey As Variant

Dim wsData As Worksheet
Dim wsAmendments As Worksheet

Application.StatusBar = "Initialising"

Set wsData = Sheets(msDataSheet)
Set wsAmendments = Sheets(msAmendmentsSheet)

With wsData
    mlStartKeyCol = .Range(msKeyColStart & "1").Column
    mlEndKeyCol = .Range(msKeyColEnd & "1").Column
    mlDataStartCol = .Range(msDataColStart & "1").Column
    mlDataEndCol = .Range(msDataColEnd & "1").Column

    lEndDataRow = .Cells(.Rows.Count, mlStartKeyCol).End(xlUp).Row
    vaData = .Range("A1").Resize(lEndDataRow, mlDataEndCol).Value
End With

With wsAmendments
    lEndRow = .Cells(.Rows.Count, mlStartKeyCol).End(xlUp).Row
    vaAmendments = .Range("A1").Resize(lEndRow, mlDataEndCol).Value
End With

PopulateAmendmentsDictionary Arrayx:=vaAmendments, _
                             Dict:=dicAmendments

lReportInterval = Int(lEndDataRow / 100)    'Report every 1% processsed

lChangesCount = 0
lCellsChangedCount = 0
For lDataRowPtr = 2 To UBound(vaData, 1)
    
    If lReportChangeRow < lDataRowPtr Then
        lReportChangeRow = lDataRowPtr + lReportInterval
        Application.StatusBar = "Procesing row " & lDataRowPtr & " of sheet '" & wsData.Name & "'"
    End If
    
    vCurDataKey = GetKey(Arrayx:=vaData, ArrayRow:=lDataRowPtr)
    On Error Resume Next
    lAmendRowPtr = 0
    If dicAmendments.exists(vCurDataKey) Then lAmendRowPtr = dicAmendments.Item(vCurDataKey)
    On Error GoTo 0
    If lAmendRowPtr <> 0 Then
        bRowChanged = False
        For lColPtr = mlDataStartCol To mlDataEndCol
            If vaData(lDataRowPtr, lColPtr) <> vaAmendments(lAmendRowPtr, lColPtr) Then
                bRowChanged = True
                vaData(lDataRowPtr, lColPtr) = vaAmendments(lAmendRowPtr, lColPtr)
            End If
        Next lColPtr
        If bRowChanged = True Then
            lChangesCount = lChangesCount + 1
            wsData.Range("A" & lDataRowPtr).Resize(, mlDataEndCol).Value _
                    = wsAmendments.Range("A" & lAmendRowPtr).Resize(, mlDataEndCol).Value
        End If
        dicAmendments.Remove vCurDataKey
    End If
Next lDataRowPtr

For Each vKey In dicAmendments.keys
    lAmendRowPtr = 0
    lAmendRowPtr = dicAmendments.Item(vKey)
    lEndDataRow = lEndDataRow + 1
    wsData.Range("A" & lEndDataRow).Resize(, mlDataEndCol).Value = wsAmendments.Range("A" & lAmendRowPtr).Resize(, mlDataEndCol).Value
Next vKey
    
Application.StatusBar = False

sMessage = lChangesCount & " rows have changed"

If dicAmendments.Count > 0 Then
    sMessage = sMessage & vbCrLf & _
               dicAmendments.Count & " rows have been appended"
End If

MsgBox sMessage

On Error Resume Next
dicAmendments.RemoveAll
Set dicAmendments = Nothing
On Error GoTo 0

End Sub

Private Sub PopulateAmendmentsDictionary(ByRef Arrayx As Variant, ByRef Dict As Object)
Dim lRowPtr As Long
Dim lColPtr As Long

Dim sKey As String

Dim vaItem As Variant

On Error Resume Next
Dict.RemoveAll
Set Dict = Nothing
On Error GoTo 0

Set Dict = CreateObject("Scripting.Dictionary")

For lRowPtr = 2 To UBound(Arrayx, 1)
    sKey = GetKey(Arrayx:=Arrayx, ArrayRow:=lRowPtr)
    If Dict.exists(sKey) Then
        MsgBox prompt:="Ignoring duplicate key in sheet '" & msAmendmentsSheet & "' row " & lRowPtr
    Else
        Dict.Add Key:=sKey, Item:=lRowPtr
    End If
Next lRowPtr
End Sub

Private Function GetKey(ByVal Arrayx As Variant, ByVal ArrayRow As Long) As String
Dim lColPtr As Long
Dim sKey As String

sKey = ""
For lColPtr = mlStartKeyCol To mlEndKeyCol
    sKey = sKey & CStr(Arrayx(ArrayRow, lColPtr)) & "|"
Next lColPtr
GetKey = Left$(sKey, Len(sKey) - 1)
End Function

 

[ujambor]

Let me take a week or two to decipher this divine work...
Thank you for now...

 

[al_b_cnu]

Hi ujambor, below is a commented version of the same code.
You may want to check out the Dictionary object before looking at the code. https://www.mrexcel.com/forum/hall-fame-winners/70924-tommy-baks-use-dictionary-object.html

Option Explicit

Const msKeyColStart As String = "A"             '1st column containing key
Const msKeyColEnd As String = "H"               'Last column containing key
Const msDataColStart As String = "K"            '1st column containing data
Const msDataColEnd As String = "V"              'Last column containing data

Const msDataSheet As String = "DATA"            'Name of data sheet
Const msAmendmentsSheet As String = "TEMP"      'Name of Amendments sheet

Const msngReportingIntervalPercent As Single = 0.01 'Report every 1% of rows

Dim mlStartKeyCol As Long                       'Calculated numeric equivalent of msKeyColStart
Dim mlEndKeyCol As Long                         'Calculated numeric equivalent of msKeyColEnd
Dim mlDataStartCol As Long                      'Calculated numeric equivalent of msDataColStart
Dim mlDataEndCol As Long                        'Calculated numeric equivalent of msDataColEnd

Sub SyncMasterSheet()

Dim bRowChanged As Boolean

Dim dicAmendments As Object

Dim lDataRowPtr As Long
Dim lAmendRowPtr As Long
Dim lEndRow As Long
Dim lEndDataRow As Long
Dim lChangesCount As Long
Dim lReportChangeRow As Long
Dim lReportInterval As Long

Dim lCellsChangedCount As Long
Dim lCellsChangedCountCur As Long
Dim lRowsAddedCount As Long
Dim lColPtr As Long

Dim sMessage As String

Dim vCurDataKey As Variant
Dim vaData As Variant
Dim vaAmendments As Variant
Dim vKey As Variant

Dim wsData As Worksheet
Dim wsAmendments As Worksheet

Application.StatusBar = "Initialising"

Set wsData = Sheets(msDataSheet)
Set wsAmendments = Sheets(msAmendmentsSheet)

'-- Calculate start and end key and data columns --
With wsData
    mlStartKeyCol = .Range(msKeyColStart & "1").Column
    mlEndKeyCol = .Range(msKeyColEnd & "1").Column
    mlDataStartCol = .Range(msDataColStart & "1").Column
    mlDataEndCol = .Range(msDataColEnd & "1").Column

    lEndDataRow = .Cells(.Rows.Count, mlStartKeyCol).End(xlUp).Row
    vaData = .Range("A1").Resize(lEndDataRow, mlDataEndCol).Value
End With

'-- Populate vaAmendments array with data from amendments worksheet --
With wsAmendments
    lEndRow = .Cells(.Rows.Count, mlStartKeyCol).End(xlUp).Row
    vaAmendments = .Range("A1").Resize(lEndRow, mlDataEndCol).Value
End With

'-- Store data in dictionary object, the key is the (unique) concatenation of A:H and the item value is the row number --
PopulateAmendmentsDictionary Arrayx:=vaAmendments, _
                             Dict:=dicAmendments

lReportInterval = Int(lEndDataRow * msngReportingIntervalPercent)   'Set report interval

lChangesCount = 0
lCellsChangedCount = 0
'---------------------------------------------------------------------------------------
'-- Loop thru DATA worksheet array.                                                   --
'-- for every row, check if there's an entry in the dictionary object 'dicAmendments' --
'--                if yes, compare data columns, if different, copy to DATA sheet.    --
'--     Whether or not the entries differ, delete the entry in the dictionary object. --
'---------------------------------------------------------------------------------------
For lDataRowPtr = 2 To UBound(vaData, 1)
    
    If lReportChangeRow < lDataRowPtr Then
        '-- Report progress --
        lReportChangeRow = lDataRowPtr + lReportInterval
        Application.StatusBar = "Processing sheet '" & wsData.Name & "' row " & lDataRowPtr & _
                                " of " & lEndDataRow
    End If
    
    vCurDataKey = GetKey(Arrayx:=vaData, ArrayRow:=lDataRowPtr)
    On Error Resume Next
    lAmendRowPtr = 0
    If dicAmendments.exists(vCurDataKey) Then lAmendRowPtr = dicAmendments.Item(vCurDataKey)
    On Error GoTo 0
    If lAmendRowPtr <> 0 Then
        bRowChanged = False
        For lColPtr = mlDataStartCol To mlDataEndCol
            If vaData(lDataRowPtr, lColPtr) <> vaAmendments(lAmendRowPtr, lColPtr) Then
                bRowChanged = True
                vaData(lDataRowPtr, lColPtr) = vaAmendments(lAmendRowPtr, lColPtr)
            End If
        Next lColPtr
        If bRowChanged = True Then
            lChangesCount = lChangesCount + 1
            wsData.Range("A" & lDataRowPtr).Resize(, mlDataEndCol).Value _
                    = wsAmendments.Range("A" & lAmendRowPtr).Resize(, mlDataEndCol).Value
        End If
        dicAmendments.Remove vCurDataKey
    End If
Next lDataRowPtr

'-----------------------------------------------------------------------------------------------
'-- Any dictionary entries are unique to TEMP worksheet, so append them to the DATA worksheet --
'-----------------------------------------------------------------------------------------------
For Each vKey In dicAmendments.keys
    lAmendRowPtr = 0
    lAmendRowPtr = dicAmendments.Item(vKey)
    lEndDataRow = lEndDataRow + 1
    wsData.Range("A" & lEndDataRow).Resize(, mlDataEndCol).Value = wsAmendments.Range("A" & lAmendRowPtr).Resize(, mlDataEndCol).Value
Next vKey
    
Application.StatusBar = False

sMessage = lChangesCount & " rows have changed"

If dicAmendments.Count > 0 Then
    sMessage = sMessage & vbCrLf & _
               dicAmendments.Count & " rows have been appended"
End If

MsgBox sMessage

On Error Resume Next
dicAmendments.RemoveAll
Set dicAmendments = Nothing
On Error GoTo 0

End Sub

Private Sub PopulateAmendmentsDictionary(ByRef Arrayx As Variant, ByRef Dict As Object)
'----------------------------------------------------------------------------------------------------------------
'-- Read array containing amendments worksheet data.
'-- Add a new entry containing the key (currently columns A:H) and an item which is the row number of the data --
'----------------------------------------------------------------------------------------------------------------
Dim lRowPtr As Long
Dim lColPtr As Long

Dim sKey As String

Dim vaItem As Variant

On Error Resume Next
Dict.RemoveAll
Set Dict = Nothing
On Error GoTo 0

Set Dict = CreateObject("Scripting.Dictionary")

For lRowPtr = 2 To UBound(Arrayx, 1)
    sKey = GetKey(Arrayx:=Arrayx, ArrayRow:=lRowPtr)
    If Dict.exists(sKey) Then
        MsgBox prompt:="Ignoring duplicate key in sheet '" & msAmendmentsSheet & "' row " & lRowPtr
    Else
        Dict.Add Key:=sKey, Item:=lRowPtr
    End If
Next lRowPtr
End Sub

Private Function GetKey(ByVal Arrayx As Variant, ByVal ArrayRow As Long) As String
'---------------------------------------------------
'-- Utility function to obtain and format the key --
'---------------------------------------------------
Dim lColPtr As Long
Dim sKey As String

sKey = ""
For lColPtr = mlStartKeyCol To mlEndKeyCol
    sKey = sKey & CStr(Arrayx(ArrayRow, lColPtr)) & "|"
Next lColPtr
GetKey = Left$(sKey, Len(sKey) - 1)
End Function