VBA code for comparing 2 excel data sheets

[kunalb84]

Hi,
I have created a macro to compare 2 data excel sheets, but I am trying to add a logic-
1st find key (column A in sheet1) in another sheet and if found compare all columns of that row
and repeat the same till the last row and if there is any diff in column then post in summary sheet with key and header name and value. But there is some issue with the code that it is not working.

Please help


Option Explicit


Sub Compare_Two_Excel_Files_Highlight_Differences()
'Define Object for Excel Workbooks to Compare
Dim sh As Integer, ShName As String, lColIdx As Long, sIdx As Long, ssh As String
Dim F1_Workbook As Workbook, F2_Workbook As Workbook, statmsg As String, trialcnt As Long
Dim iRow As Double, iCol As Double, iRow_Max As Double, iCol_Max As Double
Dim File1_Path As String, File2_Path As String, F1_Data As String, F2_Data As String, Header As String


'Assign the Workbook File Name along with its Path
File1_Path = ThisWorkbook.Sheets("Settings").Cells(2, 2)
File2_Path = ThisWorkbook.Sheets("Settings").Cells(3, 2)
iRow_Max = ThisWorkbook.Sheets("Settings").Cells(4, 2)
iCol_Max = ThisWorkbook.Sheets("Settings").Cells(5, 2)
lColIdx = ThisWorkbook.Sheets("Settings").Cells(6, 2).Interior.ColorIndex

'Open Files To Compare
Set F2_Workbook = Workbooks.Open(File2_Path)
Set F1_Workbook = Workbooks.Open(File1_Path)

' Windows("File1_Path.xlsx").Activate
' Columns("A:A").Select
' Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Range("A1").Select
' ActiveCell.FormulaR1C1 = "Key"
' Range("A2").Select
' Windows("File2_Path.xlsx").Activate
' Columns("A:A").Select
' Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Range("A1").Select
' ActiveCell.FormulaR1C1 = "Key"
' Range("A2").Select


'With F1_Workbook object, now it is possible to pull any data from it
'Read Data From Each Sheets of Both Excel Files & Compare Data
sIdx = 1
' trialcnt = 1
Header = 1
ThisWorkbook.Sheets("Summary").Cells.Clear
ThisWorkbook.Sheets("Summary").Cells(sIdx, 3) = F1_Workbook.Name
ThisWorkbook.Sheets("Summary").Cells(sIdx, 4) = F2_Workbook.Name
ThisWorkbook.Sheets("Summary").Activate
statmsg = Application.StatusBar
For sh = 1 To F1_Workbook.Sheets.Count
ShName = F1_Workbook.Sheets(sh).Name
ThisWorkbook.Sheets("Settings").Cells(7 + sh, 1) = ShName
ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2) = "Identical Sheets"
ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2).Interior.Color = vbWhite
Application.StatusBar = statmsg & " ,Processing Sheet: " & ssh

' If ThisWorkbook.Sheets("Settings").Cells(4, 2) = 0 Then iRow_Max = F1_Workbook.Sheets(ShName).Range("A:A").SpecialCells(xlLastCell).Row
' If ThisWorkbook.Sheets("Settings").Cells(5, 2) = 0 Then iCol_Max = F1_Workbook.Sheets(ShName).Range("A:A").SpecialCells(xlLastCell).Column
' For iRow = 1 To iRow_Max
' For iCol = 1 To iCol_Max
' F1_Data = F1_Workbook.Sheets(ShName).Cells(iRow, iCol)
' F2_Data = F2_Workbook.Sheets(ShName).Cells(iRow, iCol)


'Compare Data From Excel Sheets & Highlight the Mismatches
' Find row number

Dim Row As Long
Dim i As Integer
For i = 2 To ThisWorkbook.Sheets("Settings").Cells(4, 2).Value

On Error Resume Next
Row = Application.WorksheetFunction.Match(F1_Workbook.Sheets(ShName).Cells(i, 1).Value, F1_Workbook.Sheets(ShName).Range("A1:A200"), 0)


On Error GoTo 0

If lRow > 0 Then
'code


' If ThisWorkbook.Sheets("Settings").Cells(4, 2) = 0 Then iRow_Max = F1_Workbook.Sheets(ShName).Range("A:A").SpecialCells(xlLastCell).Row
' If ThisWorkbook.Sheets("Settings").Cells(5, 2) = 0 Then iCol_Max = F1_Workbook.Sheets(ShName).Range("A:A").SpecialCells(xlLastCell).Column
' For iRow = 1 To iRow_Max
' For iCol = 1 To iCol_Max


F1_Data = F1_Workbook.Sheets(ShName).Cells(i, iCol)
F2_Data = F2_Workbook.Sheets(ShName).Cells(Row, iCol)


If F1_Data <> F2_Data Then
' F1_Workbook.Sheets(ShName).Cells(iRow, iCol).Interior.ColorIndex = lColIdx
ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2) = "Mismatch Found"
ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2).Interior.ColorIndex = lColIdx
If ssh <> F1_Workbook.Sheets(sh).Name Then
sIdx = sIdx + 1
ThisWorkbook.Sheets("Summary").Cells(sIdx, 3) = F1_Workbook.Sheets(sh).Name
ThisWorkbook.Sheets("Summary").Cells(sIdx, 4) = F2_Workbook.Sheets(sh).Name
ThisWorkbook.Sheets("Summary").Cells(sIdx, 1) = F1_Workbook.Sheets(ShName).Cells(1, 1).Value
ThisWorkbook.Sheets("Summary").Cells(sIdx, 2) = "Field"
ssh = F1_Workbook.Sheets(sh).Name

End If
sIdx = sIdx + 1
' ThisWorkbook.Sheets("Summary").Cells(sIdx, 1) = F1_Workbook.Sheets(ShName).Cells(iRow, iCol).Address
ThisWorkbook.Sheets("Summary").Cells(sIdx, 2) = F1_Workbook.Sheets(ShName).Cells(Header, iCol).Value
ThisWorkbook.Sheets("Summary").Cells(sIdx, 1) = F1_Workbook.Sheets(ShName).Cells(iRow, 1).Value
ThisWorkbook.Sheets("Summary").Cells(sIdx, 3) = F1_Data
ThisWorkbook.Sheets("Summary").Cells(sIdx, 4) = F2_Data
ThisWorkbook.Sheets("Summary").Cells(sIdx, 2).Select
End If
' Next iCol


ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2) = ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2) & " (" & iRow_Max & "-Rows , " & iCol_Max & "-Cols Compared)"
' Next sh

Next i
End If
Trial_Exit:
'''''Process Completed
F2_Workbook.Close savechanges:=False
F1_Workbook.Close savechanges:=True
Set F2_Workbook = Nothing
Set F1_Workbook = Nothing
ThisWorkbook.Sheets("Settings").Activate
MsgBox "Task Completed"
Application.StatusBar = statmsg

' End With
' ThisWorkbook.Sheets("Settings").Cells(1, 4).Font.Color = vbRed
End Sub