Updating Existing Code That Highlights Discrepancies

[Jambi46n2]

Hello,

I have an existing code I use that works nicely.

Basically if I have two "identical" sheets. Lets say Sheet 1 and Sheet 2.

Sheet 1 may have a cell missing data that doesn't match the same area in Sheet 2.

This code will compare both sheets on a cell level,
then highlight the discrepancies with a message box letting you know how many discrepancies there are.

The only problem I have with this code, is if a row is missing it will highlight everything below that row as a discrepancy.

Is there a way to make this code check for missing rows as well?

Thank you!

Sub QC_Check()

If MsgBox("Highlight Discrepancies Between Sheet1 and Sheet2?", vbYesNo) = vbNo Then Exit Sub
    
'Check For Discrepancies and Highlight
' C is Cell Comparison
' Solve for X to identify discrepancies

    Dim x As Long
    x = 0
    Dim c As Range


    Sheets(1).Select
    Cells.Select
    Selection.Columns.AutoFit
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Sheets(2).Select
    Cells.Select
    Selection.Columns.AutoFit
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Sheets(1).Select


    For Each c In Sheets(1).UsedRange
        If c.Text <> Sheets(2).Range(c.Address).Text Then
            c.Interior.Color = vbYellow
            x = x + 1
        End If
    Next c


MsgBox "There Are " & x & " Discrepancies"

 

[Beyond_avarice]

How about just using a conditional format?

=IF(Sheet1!A1<>Sheet2!A1,TRUE,FALSE)

Then use the format painter for the whole sheet.

 

[Jambi46n2]

How about just using a conditional format?

=IF(Sheet1!A1<>Sheet2!A1,TRUE,FALSE)

Then use the format painter for the whole sheet.

Well I have a group of over 25 users with abysmal Excel abilities.

So I have created a custom UI within the Excel interface itself that displays buttons.

They simply point and click. So the code runs for them.

Looking for a one button solution with automation rather than manual methods.

Thank you for the input though!

 

[Jambi46n2]

Bump.. if anyone can help me out I'd really appreciate it.

 

[Jambi46n2]

My last bump before letting this sink into the abyss.

 

[Fluff]

Hia
Is this what you're after?

Sub QC_Check()

If MsgBox("Highlight Discrepancies Between Sheet1 and Sheet2?", vbYesNo) = vbNo Then Exit Sub
    
'Check For Discrepancies and Highlight
' C is Cell Comparison
' Solve for X to identify discrepancies

    Dim x As Long
    x = 0
    Dim c As Range


    With Sheets(1).Cells
        .Columns.AutoFit
        With .Interior
            .Pattern = xlNone
           .TintAndShade = 0
           .PatternTintAndShade = 0
        End With
    End With
    
    With Sheets(2).Cells
        .Columns.AutoFit
        With .Interior
            .Pattern = xlNone
           .TintAndShade = 0
           .PatternTintAndShade = 0
        End With
    End With
    
    Sheets(1).Select


    For Each c In Sheets(1).UsedRange
        If c.Text <> Sheets(2).Range(c.Address).Text Then
            c.Interior.Color = vbYellow
            If Range("A" & c.Row & ":F" & c.Row).Interior.Color = vbYellow Then
                MsgBox "Row" & c.Row
                Exit For
            End If
            
            x = x + 1
        End If
    Next c


MsgBox "There Are " & x & " Discrepancies"

End Sub