VBA

My Photo
Name:
Location: Hyderabad, Andhra Pradesh, India

Software Engineer , professional expertise in J2ee

Thursday, May 10, 2012

Compare two excel worksheets

Sub Compare()
'
' Macro1 Macro
'
' compare two different worksheets in the active workbook
  CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
End Sub

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
  Dim diffB As Boolean
  Dim r As Long, c As Integer, m As Integer
  Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
  Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
  Dim rptWB As Workbook, DiffCount As Long
  Application.ScreenUpdating = False
  Application.StatusBar = "Creating the report..."
  Application.DisplayAlerts = True
  With ws1.UsedRange
    lr1 = .Rows.Count
    lc1 = .Columns.Count
  End With
  With ws2.UsedRange
    lr2 = .Rows.Count
    lc2 = .Columns.Count
  End With
  maxR = lr1
  maxC = lc1
  If maxR < lr2 Then maxR = lr2
  If maxC < lc2 Then maxC = lc2
  DiffCount = 0
  For c = 1 To maxC
    For i = 2 To lr1
      diffB = True
      Application.StatusBar = "Comparing cells " & Format(i / maxR, "0 %") & "..."
        For r = 2 To lr2
          cf1 = ""
          cf2 = ""
          On Error Resume Next
          cf1 = ws1.Cells(i, c).FormulaLocal
          cf2 = ws2.Cells(r, c).FormulaLocal
          On Error GoTo 0
          If cf1 = cf2 Then
            diffB = False
            ws1.Cells(i, c).Interior.ColorIndex = 19
            ws1.Cells(i, c).Select
            Selection.Font.Bold = True
            Exit For
          End If
        Next r

     If diffB Then
       DiffCount = DiffCount + 1
       ws1.Cells(i, c).Interior.ColorIndex = 0
       ws1.Cells(i, c).Select
       Selection.Font.Bold = False
     End If
    Next i
  Next c
Application.StatusBar = "Formatting the report..."
'Columns("A:IV").ColumnWidth = 10
m = maxR - DiffCount - 1
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox m & " cells contain same values!", vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name
End Sub