Code To Highlight What Is In Column AD On Sheet 2 But Not In Column AD on Sheet 1 With K As The Delimiter

[Dazzawm]

I have hidden a lot of columns for clarity.

The code first needs to concentrate on column K. It needs to look at the number on sheet 2 then the corresponding number on sheet 1. It then needs to look at column AD. Any numbers that are in AD on sheet 2 but not in column AD on sheet 1 then the entire row on sheet 1 needs to be highlighted please.

For clarity I have highlighted the 4 different examples a different colour. The data in yellow as you can see the 4 numbers on sheet 2 are listed ok on sheet 1 (next to the corresponding number in K M10200360000001)

With the blue data you can see there is a difference, 2910LMB & 2910RMB (I have left clear) are on sheet 2 but when you look at the data in blue on sheet 1 they are not there so all those rows would need to be highlighted (obviously they would all be clear).

The data in green is fine as they match on sheet 1.

The data in red all the numbers are missing on sheet 1 as they say NYA in all rows so those rows would need to be highlighted.

Its one of those ones where it may be harder to explain than it is to find a solution!

Excel 2010
	K	AD
2	M10200360000001	2906LM
3	M10200360000001	2907RM
4	M10200360000001	2908LMB
5	M10200360000001	2909RMB
6	M10200360000002	2906LM
7	M10200360000002	2906LM
8	M10200360000002	2907RM
9	M10200360000002	2907RM
10	M10200360000002	2908LMB
11	M10200360000002	2910LMB
12	M10200360000002	2910RMB
13	M10200360000002	2909RMB
14	M10200360000003	2906LM
15	M10200360000003	2907RM
16	M10200360000003	2908LMB
17	M10200360000003	2909RMB
18	M10200360000004	2906LM
19	M10200360000004	2907RM
20	M10200360000004	2908LMB
21	M10200360000004	2909RMB
Sheet2

Excel 2010
	K	AD
2	M10200360000001	NYA
3	M10200360000001	NYA
4	M10200360000001	2906LM
5	M10200360000001	2907RM
6	M10200360000001	NYA
7	M10200360000001	NYA
8	M10200360000001	2908LMB
9	M10200360000001	2909RMB
10	M10200360000002	NYA
11	M10200360000002	NYA
12	M10200360000002	2906LM
13	M10200360000002	2907RM
14	M10200360000002	NYA
15	M10200360000002	NYA
16	M10200360000002	2908LMB
17	M10200360000002	2909RMB
18	M10200360000003	NYA
19	M10200360000003	NYA
20	M10200360000003	2906LM
21	M10200360000003	2907RM
22	M10200360000003	NYA
23	M10200360000003	NYA
24	M10200360000003	2908LMB
25	M10200360000003	2909RMB
26	M10200360000004	NYA
27	M10200360000004	NYA
28	M10200360000004	NYA
29	M10200360000004	NYA
30	M10200360000004	NYA
31	M10200360000004	NYA
32	M10200360000004	NYA
33	M10200360000004	NYA
Sheet1

 

[Leith Ross]

Hello Darren,

I think the problem lies with the worksheet references in the HighlightData macro.

Change this...

        ' Names of the worksheets to compare.
        Call LoadDictionary(Dict1, Sheet1)
        Call LoadDictionary(Dict2, Sheet2)

To this...

        ' Names of the worksheets to compare.
        Call LoadDictionary(Dict1, Worksheets(1))
        Call LoadDictionary(Dict2, Worksheets(2))

 

[Dazzawm]

Thankyou, I will try tomorrow at work and get back to you.

 

[Dazzawm]

That did complete and in the normal time that it has been, but nothing was highlighted? When I ran it again from the module within the file like I have been, it worked correctly|?

 

[Worf]

Fully qualify the objects:

LoadDictionary Dict1, Workbooks("sample.xlsm").Worksheets("Sheet1")
LoadDictionary Dict2, Workbooks("sample.xlsm").Worksheets("Sheet2")

 

[Dazzawm]

Thanks worf but you have a name of a workbook in your code but I will be using it on all different named books if I'm putting it in my PMW?

 

[Worf]

You have a good point… The following line refers to the first sheet of the most recent workbook to be opened:

LoadDictionary Dict1, Workbooks(Workbooks.Count).Worksheets(1)

 

[Dazzawm]

Nothing works from the personal macro workbook, only from the module within a file? Just to recap the code works perfectly below but won't work when added to the personal macro workbook.

Option Explicit




Global Dict1 As Object
Global Dict2 As Object




Sub LoadDictionary(ByRef Dict As Object, ByRef Wks As Worksheet)


    Dim Cell    As Range
    Dim cx      As Long
    Dim Data()  As Variant
    Dim Key     As String
    Dim Rng     As Range
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim x       As Long
    
        If Dict Is Nothing Then
            Set Dict = CreateObject("Scripting.Dictionary")
            Dict.CompareMode = vbTextCompare
        Else
            Dict.RemoveAll
        End If
        
            Set RngBeg = Wks.Range("K2")
            Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
            If RngEnd.Row < RngBeg.Row Then Exit Sub
            
            cx = Wks.Columns("K:AD").Count - 1
            Set Rng = Wks.Range(RngBeg, RngEnd)
            
            For Each Cell In Rng
                Key = Trim(Cell.Value)
                If Key <> "" Then
                    If Not Dict.Exists(Key) Then
                        ReDim Data(0)
                        GoSub UpdateData
                        ' Add the Key and Data to this dictionary.
                        Dict.Add Key, Data
                    Else
                        ' Return the Data for this Key.
                        Data = Dict(Key)
                        GoSub UpdateData
                        ' Save the updated Data for this Key.
                        Dict(Key) = Data
                    End If
                End If
            Next Cell
           
Exit Sub




UpdateData:
            ' Add this cell's row number to the list of rows to highlight for this Key.
            Data(0) = Data(0) & Cell.Row & ","
            
            With Cell.Offset(0, cx)
                ' Check if "AD" entry is a duplicate.
                For x = 1 To UBound(Data)
                    If Data(x) = .Value Then
                        Return
                    End If
                Next x
                ' Save the value in column "AD" in element (1) onward if it is not "NYA" nor "NLA".
                If .Value <> "NYA" And .Value <> "NLA" Then
                    ReDim Preserve Data(UBound(Data) + 1)
                    Data(UBound(Data)) = .Value
                End If
            End With
        Return




End Sub




Sub HighlightData()


    Dim Cell        As Range
    Dim Cnt         As Long
    Dim cx          As Long
    Dim Data1       As Variant
    Dim Data2       As Variant
    Dim j           As Long
    Dim k           As Long
    Dim Key         As Variant
    Dim n           As Long
    Dim nRows       As Variant
    Dim Rng         As Range
    Dim RngBeg      As Range
    Dim RngEnd      As Range
    Dim Wks         As Worksheet
     
        ' Namaes of the worksheets to compare.
        Call LoadDictionary(Dict1, ThisWorkbook.Worksheets("Sheet1"))
        Call LoadDictionary(Dict2, ThisWorkbook.Worksheets("Sheet2"))
        
        Set Wks = ThisWorkbook.Worksheets("Sheet1")
        
        cx = Wks.Columns("K:AD").Count
        
        Application.ScreenUpdating = False
        
            Set RngBeg = Wks.Range("K2")
            Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
            If RngEnd.Row < RngBeg.Row Then Exit Sub
            
            Set Rng = Wks.Range(RngBeg, RngEnd)
            
            For Each Key In Dict1.Keys
                Data1 = Dict1(Key)
                Data2 = Dict2(Key)
                Cnt = 1
                
                If VarType(Data2) <> vbEmpty Then
                    ' Check the number of entries is the same.
                    If UBound(Data1) >= UBound(Data2) Then
                        ' Loop through each column "ÄD" entry for Sheet2.
                        For k = 1 To UBound(Data2)
                            ' Check Data1 entries match Data2 entries.
                            For j = 1 To UBound(Data1)
                                If Data1(j) = Data2(k) Then
                                    Cnt = Cnt + 1
                                    Exit For
                                End If
                            Next j
                        Next k
                        
                        ' Was all of Data2 found in Data1?
                        If Cnt < UBound(Data2) Then
                            GoSub HighlightRows
                        End If
                    Else
                        GoSub HighlightRows
                    End If
                End If
            Next Key
            
        Application.ScreenUpdating = True
        
Exit Sub




HighlightRows:
            nRows = Split(Data1(0), ",")
            For n = 0 To UBound(nRows) - 1
                Wks.Cells(nRows(n), "K").Resize(1, cx).Interior.ColorIndex = 6
            Next n
        Return
        
End Sub


Sub Reset()


    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

 

[MARK858]

To start with ThisWorkbook refers to the PWB and needs to be ActiveWorkbook.

Set Wks = ThisWorkbook.Worksheets("Sheet1")

 

[Dazzawm]

To start with ThisWorkbook refers to the PWB and needs to be ActiveWorkbook.

Set Wks = ThisWorkbook.Worksheets("Sheet1")

I changed to active workbook as suggested and nothing happened.

 

[MARK858]

and did you change everywhere else where it says ThisWorkbook?