VBA comparing two sheets and two columns and check for discrepancies

Question

I'm new to vba and stackoverflow so please go easy on me!

I have two worksheets, call worksheet1 = GoldCopy and worksheet2 = A-OPS. They have about 10,000+ rows of data and should have some similar data. I want to compare the two sheets. Both of them have similar headers: Column A = filename and Column D = encryption code Column B = file path and Column F = in gold (or A-OPS depending on what ws you're looking at).

I want to be able to compare ws1 and ws2 and check for any discrepancies and highlight them as FALSE and the color red in column F. I currently want to check ws1 and go through each row, see if that filename and encryption code is in ws2, doesn't have to be the same row as ws1, but I want the filename and encryption code to be the same row (does that make sense?) WS2 could have this data in row 20 but ws1 would be on row 10 but since they have the same filename and encryption, then that's fine. If ws2 has the same filename AND same encryption code, then ws1 column F is TRUE. If ws2 does not have the same filename AND encryption in any of the rows, then ws1 column F is FALSE. I also want to do this same thing, except check ws2 against ws1.

This is the code I have so far, but it is taking forever because of these nested for loops. I have tried looking into something called "arrays" but I'm just very confused and would like something fast and efficient. The for loop is taking a really long time. Please let me know if I need to be more specific or explain more! Thanks so much

    Sub Check

    For Each s In Sheets
'NEW FILE SEARCH A-NAS OPS'
If s.Name = "A OPS" Then 'check if there is an A OPS file if so then proceed'
    ACOL = Worksheets("A OPS").Cells(1, Columns.Count).End(xlToLeft).Column
    Worksheets("A OPS").Cells(1, ACOL + 1).Value = "In Gold Copy?"
    
    'GoldCopy Check with A-NAS OPS'
    Worksheets("GoldCopy").Activate
    GROW = Worksheets("GoldCopy").Cells(Rows.Count, 1).End(xlUp).Row
    GCOL = Worksheets("GoldCopy").Cells(1, Columns.Count).End(xlToLeft).Column
    AROW = Worksheets("A OPS").Cells(Rows.Count, 1).End(xlUp).Row
    ACOL = Worksheets("A OPS").Cells(1, Columns.Count).End(xlToLeft).Column
    Worksheets("GoldCopy").Cells(1, GCOL + 1) = "Deployed in A OPS?"

    For i = 2 To GROW
        GCOL = Worksheets("GoldCopy").Cells(1, Columns.Count).End(xlToLeft).Column
        If InStr(Worksheets("GoldCopy").Cells(i, 3), "\sidata\") > 0 Then        'this is checking to see for a filepath from column B'
            bln = False
            For x = 2 To AROW
                If Worksheets("GoldCopy").Cells(i, 1).Value = Worksheets("A OPS").Cells(x, 1) And Worksheets("GoldCopy").Cells(i, 4).Value = Worksheets("A OPS").Cells(x, 4).Value Then    'if the filename and encryption code in the same row in ws2 match ws1 then do next step' 
                    bln = True
                    Worksheets("GoldCopy").Cells(i, GCOL) = bln
                    Worksheets("GoldCopy").Cells(i, GCOL).Interior.ColorIndex = 10
                    Exit For
                Else
                    Worksheets("GoldCopy").Cells(i, GCOL) = bln
                    Worksheets("GoldCopy").Cells(i, GCOL).Interior.ColorIndex = 22
                End If
            Next x
        End If
    Next i
            
    'A OPS check with GoldCopy'
    Worksheets("A OPS").Activate
    GROW = Worksheets("GoldCopy").Cells(Rows.Count, 1).End(xlUp).Row
    GCOL = Worksheets("GoldCopy").Cells(1, Columns.Count).End(xlToLeft).Column
    AROW = Worksheets("A OPS").Cells(Rows.Count, 1).End(xlUp).Row
    ACOL = Worksheets("A OPS").Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 2 To AROW
        GCOL = Worksheets("GoldCopy").Cells(1, Columns.Count).End(xlToLeft).Column
        If InStr(Worksheets("A OPS").Cells(i, 3), "\SIDATA\ops\common\") > 0 Or InStr(Worksheets("A OPS").Cells(i, 3), "\SIDATA\ops\j01\ecl\") > 0 Or InStr(Worksheets("A OPS").Cells(i, 3), "\SIDATA\ops\npp\ecl\") > 0 Then
            bln = False
            For x = 2 To GROW
                If Worksheets("GoldCopy").Cells(x, 1).Value = Worksheets("A OPS").Cells(i, 1) And Worksheets("GoldCopy").Cells(x, 4).Value = Worksheets("A OPS").Cells(i, 4).Value Then
                    bln = True
                    Worksheets("A OPS").Cells(i, ACOL) = bln
                    Worksheets("A OPS").Cells(i, ACOL).Interior.ColorIndex = 10
                    
                    Exit For
                Else
                    Worksheets("A OPS").Cells(i, ACOL) = bln
                    Worksheets("A OPS").Cells(i, ACOL).Interior.ColorIndex = 22
                    
                End If
            Next
        End If
    Next

basodre basodre · Accepted Answer · 2020-11-17T20:21:13

Try to work through the below code. I dispersed comments throughout the code to indicate what the code does and why it does it. See if you can adapt it to your actual workbook. If you run into issues, write back and we'll try to work through them.

'Below code drives the analysis. Get a dictionary of
'unique keys from each sheet, then compare each sheet
'separately. You can pull your "response" into a separate
'function if you need the flexibility to change
Sub AnalyzeSheets()
    Dim oGold As Object
    Dim oAops As Object
    Dim shtGold As Worksheet
    Dim shtOps As Worksheet
    Dim rngGold As Range
    Dim rngOps As Range
    Dim iterator As Range
    Dim theKey As String
    
    Set shtGold = Worksheets("GoldCopy")
    Set shtOps = Worksheets("A Ops")
    
    'Establish the data range for each sheet
    'Mine is simply hardcoded
    Set rngGold = shtGold.Range("A2:E8")
    Set rngOps = shtOps.Range("A2:E7")
    
    'Get a dictionary for each sheet. Pass in
    'the range of the data
    Set oGold = GetDictionary(rngGold)
    Set oAops = GetDictionary(rngOps)
    
    'Analyze each sheet separately
    'Use Intersect to only iterate over the cells in the first column
    For Each iterator In Intersect(rngGold, shtGold.Columns(1))
        theKey = CreateKey(iterator.Value, iterator.Offset(, 3).Value)
        
        If Not oAops.exists(theKey) Then
            Respond iterator, False
        Else
            Respond iterator, True
        End If
    Next iterator
    
    For Each iterator In Intersect(rngOps, shtOps.Columns(1))
        theKey = CreateKey(iterator.Value, iterator.Offset(, 3).Value)
        
        If Not oGold.exists(theKey) Then
            'Call a response function. By putting the response
            'into it's own function, you don't have to duplicate logic
            'and it's easier to change
            Respond iterator, False
        Else
            Respond iterator, True
        End If
    Next iterator
End Sub

Sub Respond(rng As Range, isFound As Boolean)
    Dim sht As Worksheet
    
    Set sht = rng.Parent
    
    If isFound Then
        sht.Range("F" & rng.Row).Value = "TRUE"
        sht.Range("F" & rng.Row).Interior.ColorIndex = 10
    Else
        sht.Range("F" & rng.Row).Value = "FALSE"
        sht.Range("F" & rng.Row).Interior.ColorIndex = 22

    End If
    
End Sub

'Use this function to generate a unique key for each row
'Since 2 columns form a unique key, I'm simply taking each
'value and joining with a hypen. By pulling this logic into
'it's own function, you have more flexibility for future changes.
Function CreateKey(s1 As String, s2 As String) As String
    Dim delimiter As String
    
    delimiter = "-"
    
    CreateKey = s1 & delimiter & s2
End Function

'Use below to create a dictionary holding unique key values
'You can update the code within to identify which cells
'are used to generate a key
Function GetDictionary(inputRange As Range) As Object
    Dim oDict As Object
    Dim sht As Worksheet
    Dim cel As Range
    Dim theKey As String
    
    Set sht = inputRange.Parent
    
    Set oDict = CreateObject("Scripting.Dictionary")
    
    For Each cel In Intersect(inputRange, sht.Columns(1))
        '(A) - Filename (D) - Encryption
        theKey = CreateKey(sht.Range("A" & cel.Row).Value, _
                    sht.Range("D" & cel.Row).Value)
        
        'If the key hasn't been added, add it (don't need value)
        If Not oDict.exists(theKey) Then
            oDict.Add theKey, ""
        End If
    Next cel
    
    Set GetDictionary = oDict
End Function

VBA comparing two sheets and two columns and check for discrepancies

1 Answers