Compare 2 excel sheets and mark red where ever changes.

Hi,

I need a macro which can compare 2 sheets and tell me what are the differences between them.

Regards
Sharath
LVL 11
bsharathAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Hitesh ManglaniCommented:
Sub sComp()
 Dim s1 As Worksheet, s2 As Worksheet
 Dim i As Integer, j As Integer, k As Integer
 Dim Id As Integer, lastCol As Integer
 Dim fcell As Range
 'assume compared sheets are first and second
 Set s1 = ThisWorkbook.Worksheets(1)
 Set s2 = ThisWorkbook.Worksheets(2)
 Set s3 = ThisWorkbook.Worksheets(3)
 k = 1
 lastCol = s1.UsedRange.Columns.Count
 For i = 2 To s1.UsedRange.Rows.Count
   Id = s1.Cells(i, 1)
   Set fcell = s2.Columns(1).Find(Id)
   If fcell Is Nothing Then
     s3.Cells(k, 1) = "Item ID #" & Id & " is missing at sheet " & s2.Name
     k = k + 1
   Else
     If fcell.Row <> i Then
       s3.Cells(k, 1) = "Item ID #" & Id & " at sheet " & s2.Name & " is shifted on " & Abs(fcell.Row - i) & " rows"
       If (fcell.Row > i) Then
         s3.Cells(k, 1) = s3.Cells(k, 1) & " upwards"
       Else
         s3.Cells(k, 1) = s3.Cells(k, 1) & " downwards"
       End If
       k = k + 1
     End If
     For j = 2 To lastCol
       If s1.Cells(i, j) <> s2.Cells(fcell.Row, j) Then
         s3.Cells(k, 1) = "Item ID #" & Id & " at sheet " & s2.Name & " has difference in field #" & j
         k = k + 1
       End If
     Next j
   End If
  Next i
End Sub
0
bsharathAuthor Commented:
Will this copare 2 Sheets in the same file or 2 work sheets.Where will the output come.
0
Hitesh ManglaniCommented:
it will compare sheet1 and sheet2 in the same file and output will come in sheet3 of same file.
Regards
Hitesh
0
Acronis True Image 2019 just released!

Create a reliable backup. Make sure you always have dependable copies of your data so you can restore your entire system or individual files.

bsharathAuthor Commented:
I get this.

Run-time error '13'.
Type mismatch
0
Jeroen RosinkSoftware testing consultantCommented:
here another macro,

perhaps this works for you:
Sub WorksheetCompare()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim var1 As Variant, var2 As Variant
Dim cel As Range
Dim i As Long, j As Long, nrows As Long, nCols As Long
Set ws1 = ActiveSheet
Set ws2 = Worksheets(InputBox("Enter name of worksheet to compare to"))
nrows = Application.Max(ws1.UsedRange.Rows.Count, ws2.UsedRange.Rows.Count)
nCols = Application.Max(ws1.UsedRange.Columns.Count, ws2.UsedRange.Columns.Count)
For i = 1 To nrows
For j = 1 To nCols
    var1 = ws1.Cells(i, j)
    var2 = ws2.Cells(i, j)
    If IsError(var1) Or IsError(var2) Then
        ws1.Cells(i, j).Interior.ColorIndex = 4
        ws2.Cells(i, j).Interior.ColorIndex = 4
    Else
        If ws1.Cells(i, j) <> ws2.Cells(i, j) Then
            ws1.Cells(i, j).Interior.ColorIndex = 4
            ws2.Cells(i, j).Interior.ColorIndex = 4
        End If
    End If
Next j
Next i
End Sub

regards,
Jeroen
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bsharathAuthor Commented:
I get this.

---------------------------
Windows Script Host
---------------------------
Today there were 5 ide Files created
---------------------------
OK  
---------------------------


But there are many file.
0
bsharathAuthor Commented:
Sorry wrong post ...
0
Jeroen RosinkSoftware testing consultantCommented:
Thanks for the grade!
Jeroen
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Legacy OS

From novice to tech pro — start learning today.