How to compare between 2 workbooks containing 3 sheets - excel

Question

I try to work on a Project but it seems that it's far from my ability.
I need to Compare 2 workbooks containing 3 sheets ("WireList", "Cumulated BOM" and "BOM"), when I Browse File 1 and File 2 all sheets should compare at the same time and give the result in the format below:
I try a lot of codes but I am still a beginner and I hope if possible someone can help
Thank you very Much
Code Examples 1 : (Just to compare)
Option Explicit
Sub Compare()
'Define Object for Excel Workbooks to Compare
Dim sh As Integer, shName As String
Dim F1_Workbook As Workbook, F2_Workbook As Workbook
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
'Assign the Workbook File Name along with its Path
File1_Path = ThisWorkbook.Sheets(1).Cells(1, 2)
File2_Path = ThisWorkbook.Sheets(1).Cells(2, 2)
iRow_Max = ThisWorkbook.Sheets(1).Cells(3, 2)
iCol_Max = ThisWorkbook.Sheets(1).Cells(4, 2)
Set F2_Workbook = Workbooks.Open(File2_Path)
Set F1_Workbook = Workbooks.Open(File1_Path)
ThisWorkbook.Sheets(1).Cells(6, 2) = F1_Workbook.Sheets.Count
'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
For sh = 1 To F1_Workbook.Sheets.Count
shName = F1_Workbook.Sheets(sh).Name
ThisWorkbook.Sheets(1).Cells(7 + sh, 1) = shName
ThisWorkbook.Sheets(1).Cells(7 + sh, 2) = "Identical Sheets"
ThisWorkbook.Sheets(1).Cells(7 + sh, 2).Interior.Color = vbGreen
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
If F1_Data <> F2_Data Then
F1_Workbook.Sheets(shName).Cells(iRow, iCol).Interior.Color = vbYellow
ThisWorkbook.Sheets(1).Cells(7 + sh, 2) = "Mismatch Found"
ThisWorkbook.Sheets(1).Cells(7 + sh, 2).Interior.Color = vbYellow
End If
Next iCol
Next iRow
Next sh
'Process Completed
ThisWorkbook.Sheets(1).Activate
MsgBox "Task Completed - Thanks for Visiting OfficeTricks.Com"
End Sub
Code Example 2 :
Option Explicit
Sub test_CompareSheets_Adv()
ActiveWorkbook.Activate
If SheetExists("results") = False Then
Sheets.Add
ActiveSheet.Name = "results"
End If
If CompareSheets_Adv("Sheet3", "Sheet4") = True Then
MsgBox " Completed Successfully!"
Else
MsgBox "Process Failed"
End If
End Sub
Function CompareSheets_Adv(sh1Name$, sheet2name$) As Boolean
Dim vstr As String
Dim vData As Variant
Dim vitm As Variant
Dim vArr As Variant
Dim v()
Dim a As Long
Dim b As Long
Dim c As Long
On Error GoTo CompareSheetsERR
vData = Sheets(sh1Name$).Range("A1:T6817").Value
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
ReDim v(1 To UBound(vData, 2))
For a = 2 To UBound(vData, 1)
For b = 1 To UBound(vData, 2)
vstr = vstr & Chr(2) & vData(a, b)
v(b) = vData(a, b)
Next
.Item(vstr) = v
vstr = ""
Next
vData = Sheets(sheet2name$).Range("A1:T6817").Value
For a = 2 To UBound(vData, 1)
For b = 1 To UBound(vData, 2)
vstr = vstr & Chr(2) & vData(a, b)
v(b) = vData(a, b)
Next
If .exists(vstr) Then
.Item(vstr) = Empty
Else
.Item(vstr) = v
End If
vstr = ""
Next
For Each vitm In .keys
If IsEmpty(.Item(vitm)) Then
.Remove vitm
End If
Next
vArr = .items
c = .Count
End With
With Sheets("Results").Range("a1").Resize(, UBound(vData, 2))
.Cells.Clear
.Value = vData
If c > 0 Then
.Offset(1).Resize(c).Value = Application.Transpose(Application.Transpose(vArr))
End If
End With
CompareSheets_Adv = True
Exit Function
CompareSheetsERR:
CompareSheets_Adv = False
End Function
Function SheetExists(shName As String) As Boolean
With ActiveWorkbook
On Error Resume Next
SheetExists = (.Sheets(shName).Name = shName)
On Error GoTo 0
End With
End Function