Excel VBA using dictionary to compare multiple columns in two worksheet ranges

[kaz123]

Hi - I have two sets of employee data from two sources, both in separate worksheets within the same workbook. Both sets of data have same 5 columns, e.g employee number, employee name, line manager, email address and department. I need to compare (based on the unique employee number) of any of the values are different between the two worksheets and highlight the cell if they are.

I have the below code which helps me to compare one column (the emp no) but can anyone help me how I could extend that to compare all the other 4 columns.

Sub CompareLists()
Dim Rng As Range, RngList As Object

Set RngList = CreateObject("Scripting.Dictionary")

Worksheets("Employee1").Activate
'''Make a list of the ColumnA items...
For Each Rng In Worksheets("Employee1").Range("A2", Range("A" & Rows.Count).End(xlUp))
If Not RngList.Exists(Rng.Value) Then
RngList.Add Rng.Value, Nothing
End If
Next

Worksheets("Employee2").Activate

'''Go through Col.A and test for existance of each value in Col.A
'''(Highlight items in Column A that are NOT found in Column A in other sheet)
For Each Rng In Worksheets("Employee2").Range("A2", Range("A" & Rows.Count).End(xlUp))
If Not RngList.Exists(Rng.Value) Then
Rng.Interior.ColorIndex = 3
End If
Next


Set List = Nothing

End Sub

 

[Fluff]

Hi & welcome to MrExcel
Try this

Sub CompareLists()
    Dim Rng As Range, RngList As Object
    
    Set RngList = CreateObject("Scripting.Dictionary")
    
    Worksheets("Employee1").Activate
    '''Make a list of the ColumnA items...
    For Each Rng In Worksheets("Employee1").Range("A2", Worksheets("Employee1").Range("A" & Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Rng.Row
        End If
    Next Rng
    
    Worksheets("Sheet2").Activate
    
    '''Go through Col.A and test for existance of each value in Col.A
    '''(Highlight items in Column A that are NOT found in Column A in other sheet)
    For Each Rng In Worksheets("Employee2").Range("A2", Worksheets("Employee2").Range("A" & Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value) Then
            Rng.Interior.ColorIndex = 3
        ElseIf Rng.Offset(, 1) <> Worksheets("Employee1").Range("B" & RngList(Rng.Value)) Then
            Rng.Offset(, 1).Interior.ColorIndex = 3
        ElseIf Rng.Offset(, 2) <> Worksheets("Employee1").Range("C" & RngList(Rng.Value)) Then
            Rng.Offset(, 1).Interior.ColorIndex = 3
        End If
    Next Rng
    
    
    Set RngList = Nothing

End Sub

Adding more ElseIf statements for the other columns

 

[kaz123]

Hi - thanks very much for your answer. It does the comparison really fast. The only issue is when there is more than one value that is different the macro only highlights the last value that is different instead of all. So for instance if the employees line manager and department differs the macro only highlights department instead of both.

 

[Fluff]

Ok, try

Sub CompareLists()
    Dim Rng As Range
    Dim RngList As Object
    Dim Sht1 As Worksheet
    Dim Sht2 As Worksheet
    
    Set RngList = CreateObject("Scripting.Dictionary")
    Set Sht1 = Worksheets("Employee1")
    Set Sht2 = Worksheets("Employee2")
    
    '''Make a list of the ColumnA items...
    For Each Rng In Sht1.Range("A2", Sht1.Range("A" & Rows.Count).End(xlUp))
        If Not RngList.exists(Rng.Value) Then
            RngList.Add Rng.Value, Rng.Row
        End If
    Next Rng
    
    
    '''Go through Col.A and test for existance of each value in Col.A
    '''(Highlight items in Column A that are NOT found in Column A in other sheet)
    For Each Rng In Sht2.Range("A2", Sht2.Range("A" & Rows.Count).End(xlUp))
        If Not RngList.exists(Rng.Value) Then Rng.Interior.ColorIndex = 3
        If Rng.Offset(, 1) <> Sht1.Range("B" & RngList(Rng.Value)) Then Rng.Offset(, 1).Interior.ColorIndex = 3
        If Rng.Offset(, 2) <> Sht1.Range("C" & RngList(Rng.Value)) Then Rng.Offset(, 2).Interior.ColorIndex = 3
        If Rng.Offset(, 3) <> Sht1.Range("D" & RngList(Rng.Value)) Then Rng.Offset(, 3).Interior.ColorIndex = 3
    Next Rng
    
    
    Set RngList = Nothing

End Sub

Adding more if statements as required

 

[kaz123]

Thanks for that, I tried but get the error message below:

Run-time error ‘1004’;
Method ‘Range’ of object’ _Worksheet failed

Debugging highlights below line:


If Rng.Offset(, 1) <> Sht1.Range("B" & RngList(Rng.Value))

 

[Fluff]

Ok, rejigged it somewhat

Sub CompareLists()
    Dim Rng As Range
    Dim RngList As Object
    Dim Sht1 As Worksheet
    Dim Sht2 As Worksheet
    
    Set RngList = CreateObject("scripting.dictionary")
    Set Sht1 = Worksheets("Employee1")
    Set Sht2 = Worksheets("Employee2")
    
    '''Make a list of the ColumnA items...
    With RngList
        .CompareMode = vbTextCompare
        For Each Rng In Sht1.Range("A2", Sht1.Range("A" & Rows.Count).End(xlUp))
            If Not .exists(Rng.Value) Then .Add Rng.Value, Rng.Row
        Next Rng
    
    
    '''Go through Col.A and test for existance of each value in Col.A
    '''(Highlight items in Column A that are NOT found in Column A in other sheet)
        For Each Rng In Sht2.Range("A2", Sht2.Range("A" & Rows.Count).End(xlUp))
            If .exists(Rng.Value) Then
                If Rng.Offset(, 1) <> Sht1.Range("B" & RngList(Rng.Value)) Then Rng.Offset(, 1).Interior.ColorIndex = 3
                If Rng.Offset(, 2) <> Sht1.Range("C" & RngList(Rng.Value)) Then Rng.Offset(, 2).Interior.ColorIndex = 3
                If Rng.Offset(, 3) <> Sht1.Range("D" & RngList(Rng.Value)) Then Rng.Offset(, 3).Interior.ColorIndex = 3
            Else
                Rng.Interior.ColorIndex = 3
            End If
        Next Rng
    End With
    
    Set RngList = Nothing

End Sub

 

[kaz123]

Thanks so much, this now works brilliantly.

 

[Fluff]

Glad to help & thanks for the feedback