Introduction
Any Excel Comparator does the comparison for single Tab at a time but this Entire script compares the number of tabs present in both the excel sheets provided.
Background
The VBScript needs to be provided with Source Files (to be compared) and a path for the Result File to be stored. The Script then can be run (w/o opening the Excels). And the script itself navigates through the tabs one after another and compares the data present.
The code
Code: VB
'Provide the File details here
xlfile1 = "C:\File1.xls"
xlfile2 = "C:\File2.xls"
resfile = "C:\ResFile.xls"
Res = ExcelCmp(xlfile1,xlfile2,resfile)
' Function to compare the two excel files
Public Function ExcelCmp(firstFile,secondFile,resultFile)
' Declaring varaibles
Dim objExcel1,objExcel2,objSpread1,objSpread2
Dim strCount,x1,x2,y1,y2,maxR,maxC,DiffCount,PDiffCount,limit
Dim cf1,cf2,fOffset,resOffSet,sMsg
Dim returnVal 'As Boolean
returnVal = False
limit = 1
' Creates object of the two Excel files
Set objExcel1 = CreateObject("Excel.Application")
objExcel1.displayalerts = false
Set objSpread1 = objExcel1.Workbooks.Open(firstFile)
Set objSpread2 = objExcel1.Workbooks.Open(secondFile)
Set resBook = objExcel1.Workbooks.Add
resBook.Sheets(1).Name = "Result"
Set resWorkSheet = resBook.WorkSheets("Result")
'Preparing the Headers and details in the Result File
resWorkSheet.Cells(1,1) = "This is a result file which highlights the differences between the Files ..."
resWorkSheet.Cells(2,1) = "File 1 : " + firstFile
resWorkSheet.Cells(3,1) = "File 2 : " + secondFile
resWorkSheet.Cells(4,1) = "'==========================================================================================="
resWorkSheet.Range(resWorkSheet.Cells(1,1), resWorkSheet.Cells(1,12)).Merge
resWorkSheet.Range(resWorkSheet.Cells(2,1), resWorkSheet.Cells(2,12)).Merge
resWorkSheet.Range(resWorkSheet.Cells(3,1), resWorkSheet.Cells(3,12)).Merge
resWorkSheet.Range(resWorkSheet.Cells(4,1), resWorkSheet.Cells(4,12)).Merge
resWorkSheet.Cells(6,1) = "Item Name"
resWorkSheet.Cells(6,1).Font.Bold = TRUE
resWorkSheet.Cells(6,2) = "Location"
resWorkSheet.Cells(6,2).Font.Bold = TRUE
resWorkSheet.Cells(6,3) = "Data in File 1"
resWorkSheet.Cells(6,3).Font.Bold = TRUE
resWorkSheet.Cells(6,4) = "Data in File 2"
resWorkSheet.Cells(6,4).Font.Bold = TRUE
resOffSet = 7
' Get the number of worksheets used
strCount = objSpread1.Worksheets.Count
DiffCount = 0
PDiffCount = 0
'MsgBox strCount
'Loop to identify the differences per worksheet
For i = 1 To strCount
'Get the row and column count of the first worksheet
Set objWorksheet1 = objSpread1.Worksheets(i)
With objWorksheet1.UsedRange
x1 = .Rows.Count
y1 = .Columns.Count
End With
'MsgBox x1 & " >> " & y1
For tOff = 1 to x1
If (objWorksheet1.Cells(tOff,1) <> "")Then
fOffset = tOff
Exit For
End If
Next
'Get the row and column count of the the secound worksheet
Set objWorksheet2 = objSpread2.Worksheets(i)
With objWorksheet2.UsedRange
x2 = .Rows.Count
y2 = .Columns.Count
End With
maxR = x1
maxC = y1
If maxR < x2 Then
maxR = x2
End If
If maxC < y2 Then
maxC = y2
End If
'Loop to find the differences between the two files (cell by cell )
cf1 = ""
cf2 = ""
For c = 1 To maxC
For r = 1 To (maxR+fOffset)
On Error Resume Next
cf1 = LTrim(RTrim(objWorksheet1.Cells(r,c).Value))
cf2 = LTrim(RTrim(objWorksheet2.Cells(r,c).Value))
PDiffCount = DiffCount
If Isnumeric(cf1) And Isnumeric(cf2) Then
If Abs(cf1-cf2) > limit Then
DiffCount = DiffCount+1
End If
Else
If cf1 <> cf2 Then
DiffCount = DiffCount+1
End If
End If
If DiffCount >= (PDiffCount+1) Then
objWorksheet1.Cells(r,c).Interior.ColorIndex = 3
objWorksheet2.Cells(r,c).Interior.ColorIndex = 3
resWorkSheet.Cells(resOffSet,1) = objWorksheet1.Cells(fOffset,c).Value
resWorkSheet.Cells(resOffSet,2).Formula = "=Address("&r&","&c&",4)"
resWorkSheet.Cells(resOffSet,3) = objWorksheet1.Cells(r,c).Value
resWorkSheet.Cells(resOffSet,4) = objWorksheet2.Cells(r,c).Value
resOffSet = resOffSet + 1
End If
cf1 = ""
cf2 = ""
Next
Next
Next
If DiffCount=0 Then
sMsg = "No Errors Found !!!"
returnVal = True
Else
resBook.SaveAs resultFile
sMsg = "Error in Validation : " & DiffCount & " Items Mismatches!!!" & vbLF & "Results File available at : " & resultFile
End If
resBook.Close
objSpread1.Close
objSpread2.Close
objExcel1.displayalerts = True
objExcel1.Quit
Set objSpread1 = Nothing
Set objSpread2 = Nothing
Set objExcel1 = Nothing
Set resBook = Nothing
Excelcmp = sMsg
End Function
