Hi Everyone,
I need to compare workbooks of two different folders externally through a vba code in a excel sheet named Final as attached. I have a folder a with workbooks named file2,file2..and so on similarly another folder with workbooks having same name. For that i have developed a code mentioned below, what it does is compare workbooks having same name from two folders and highlight the mismatch.This i have done for one pair as shown in excel attached for file 1. But I am unable to write a code for running this for all pairs one after other. Guyz please help in looping the filepath as mentioned in attached file so that i can run programme all files one after other. Filepaths are always mentioned in A & B Cloumns.
Option Explicit
Sub Compare_Excel_Files_WorkSheets()
'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(2, 1)
File2_Path = ThisWorkbook.Sheets(1).Cells(2, 2)
iRow_Max = ThisWorkbook.Sheets(1).Cells(2, 3)
iCol_Max = ThisWorkbook.Sheets(1).Cells(2, 4)
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 "
End Sub
I need to compare workbooks of two different folders externally through a vba code in a excel sheet named Final as attached. I have a folder a with workbooks named file2,file2..and so on similarly another folder with workbooks having same name. For that i have developed a code mentioned below, what it does is compare workbooks having same name from two folders and highlight the mismatch.This i have done for one pair as shown in excel attached for file 1. But I am unable to write a code for running this for all pairs one after other. Guyz please help in looping the filepath as mentioned in attached file so that i can run programme all files one after other. Filepaths are always mentioned in A & B Cloumns.
Option Explicit
Sub Compare_Excel_Files_WorkSheets()
'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(2, 1)
File2_Path = ThisWorkbook.Sheets(1).Cells(2, 2)
iRow_Max = ThisWorkbook.Sheets(1).Cells(2, 3)
iCol_Max = ThisWorkbook.Sheets(1).Cells(2, 4)
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 "
End Sub