CODEWITHSUNDEEP
vbaexcelcomparematch
Stupid_Intern
Stupid_Intern

Reputation: 3450

Match data on two sheets color yellow if different

I am trying to Check Data on two Sheets.

Logic:

IF Col A-B-C Data on Sheet2 match with data on any row same column on Sheet1 .Then check for col E and col F on both sheets and color them yellow if any data is different on Sheet2

Code: 

Option Explicit
Sub CheckData()

Dim wb, wn As Worksheet
Dim i, j, m
Dim strA, strB, strC, strE, strF, NstrA, NstrB, NstrC, NstrE, NstrF As String
Dim FinalRowB, FinalRowN, count

Set wb = Sheets(1)
Set wn = Sheets(2)

FinalRowB = wb.Range("A900000").End(xlUp).Row
FinalRowN = wn.Range("A900000").End(xlUp).Row

For i = 2 To FinalRowN

    NstrA = wn.Range("A" & i).Value
    NstrA = Trim(NstrA)

    NstrB = wn.Range("B" & i).Value
    NstrB = Trim(NstrB)

    NstrC = wn.Range("C" & i).Value
    NstrC = Trim(NstrC)

    NstrE = wn.Range("E" & i).Value
    NstrE = Trim(NstrE)

    NstrF = wn.Range("F" & i).Value
    NstrF = Trim(NstrF)

    For j = 2 To FinalRowB

        strA = wb.Range("A" & j).Value
        strA = Trim(strA)

        strB = wb.Range("B" & j).Value
        strB = Trim(strB)

        strC = wb.Range("C" & j).Value
        strC = Trim(strC)

        strE = wb.Range("E" & j).Value
        strE = Trim(strE)

        strF = wb.Range("F" & j).Value
        strF = Trim(strF)

            'Check if A-B-C Matched? if yes then check E or F mark yellow if Different
            If strA = NstrA And strB = NstrB And strC = NstrC Then

                If strE <> NstrE Then
                    wn.Range("E" & j).Interior.ColorIndex = 6
                Else

                If strF <> NstrF Then
                    wn.Range("F" & j).Interior.ColorIndex = 6
                Else: End If

                End If

            Else: End If

    Next j
Next i

End Sub

Don't know where I am wrong with this one.

Upvotes: 0

Views: 56

Answers (2)

Andy Brazil
Andy Brazil

Reputation: 1

Alternatively, and a bit faster

Sub CheckData()

Dim wb As Worksheet
Dim wn As Worksheet

Dim FinalRowB As Long
Dim FinalRowN As Long

Dim s As String
Dim r As Range
Dim x As Long
Dim v
Set wb = Sheets(1)
Set wn = Sheets(2)

FinalRowB = wb.Range("A900000").End(xlUp).Row
FinalRowN = wn.Range("A900000").End(xlUp).Row
wb.Columns("e").Insert

'concatenate three columns to one
wb.Range("e1").Formula = "=a1&b1&c1"
wb.Range("e1").Copy wb.Range("e1:e" & FinalRowB)

v = wb.Range("e1:g" & FinalRowB) 'copy everything into an array

For Each r In wn.Range("a1:a" & FinalRowN)  'step through second sheet
    s = r & r.Offset(0, 1) & r.Offset(0, 2) 'build search string
    For x = 1 To FinalRowB
        If v(x, 1) = s Then
            If v(x, 2) = r.Offset(0, 4) And v(x, 3) = r.Offset(0, 5) Then
              'fg match
            Else
                r.Offset(0, 4).Interior.ColorIndex = 6
                r.Offset(0, 5).Interior.ColorIndex = 6
            End If

        End If
    Next x
Next r
wb.Columns("e").Delete  'tidy up afterwards
End Sub

Upvotes: 0

R3uK
R3uK

Reputation: 14537

You have just mess with the End If in you tests and it should have been i in your ranges that you'll color :

If strA = NstrA And strB = NstrB And strC = NstrC Then
    If strE <> NstrE Then
        wn.Range("E" & i).Interior.ColorIndex = 6
    Else: End If

    If strF <> NstrF Then
        wn.Range("F" & i).Interior.ColorIndex = 6
    Else: End If
Else: End If

Here is your full code, already a bit cleaned :

Option Explicit
'Option Compare Text
Sub CheckData()
Dim wb, wn As Worksheet
Dim i, j, m
Dim strA, strB, strC, strE, strF, NstrA, NstrB, NstrC, NstrE, NstrF As String
Dim FinalRowB, FinalRowN, count

Set wb = Sheets(1)
Set wn = Sheets(2)
FinalRowB = wb.Range("A" & wb.Rows.count).End(xlUp).Row
FinalRowN = wn.Range("A" & wn.Rows.count).End(xlUp).Row

For i = 2 To FinalRowN
    NstrA = Trim(wn.Range("A" & i).Value)
    NstrB = Trim(wn.Range("B" & i).Value)
    NstrC = Trim(wn.Range("C" & i).Value)
    NstrE = Trim(wn.Range("E" & i).Value)
    NstrF = Trim(wn.Range("F" & i).Value)

    For j = 2 To FinalRowB
        strA = Trim(wb.Range("A" & j).Value)
        strB = Trim(wb.Range("B" & j).Value)
        strC = Trim(wb.Range("C" & j).Value)
        strE = Trim(wb.Range("E" & j).Value)
        strF = Trim(wb.Range("F" & j).Value)

        'Check if A-B-C Matched?
        If strA <> NstrA Or strB <> NstrB Or strC <> NstrC Then
        Else
            'if yes then check E or F and mark yellow if Different
            If strE <> NstrE Then wn.Range("E" & i).Interior.ColorIndex = 6
            If strF <> NstrF Then wn.Range("F" & i).Interior.ColorIndex = 6
        End If
    Next j
Next i

End Sub

Upvotes: 1

Related Questions