Go4Expert

Go4Expert (http://www.go4expert.com/)
-   Web Design, HTML And CSS Tutorials (http://www.go4expert.com/articles/web-design/)
-   -   VB Script to Compare Two Excel Files with Multiple Tabs (http://www.go4expert.com/articles/vb-script-compare-excel-files-multiple-t18330/)

naimish 3Jul2009 15:41

VB Script to Compare Two Excel Files with Multiple Tabs
 

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


SaswatPadhi 3Jul2009 18:23

Re: VB Script to Compare Two Excel Files with Multiple Tabs
 
Why do you rate your own articles as 5.00 ??!?

Let the members rate it ! An author obviously likes his/her own article.

nimesh 3Jul2009 22:40

Re: VB Script to Compare Two Excel Files with Multiple Tabs
 
Nice one.
Few days back someone was asking me if I can write an excel macro to compare to sheets/workbooks :)

David Michael 6Jul2009 19:12

Re: VB Script to Compare Two Excel Files with Multiple Tabs
 
its easy, you freeze the rows and see what happen.

naimish 7Jul2009 15:52

Re: VB Script to Compare Two Excel Files with Multiple Tabs
 
Quote:

Originally Posted by SaswatPadhi (Post 51276)
Why do you rate your own articles as 5.00 ??!?

Let the members rate it ! An author obviously likes his/her own article.

Q : Why do you rate your own articles ??!?

A : An author obviously likes his/her own article.

Any more clarification ?

shabbir 3Aug2009 14:34

Re: VB Script to Compare Two Excel Files with Multiple Tabs
 
Nominate this article for Article of the month - Jul 2009

naimish 20Aug2009 15:58

Re: VB Script to Compare Two Excel Files with Multiple Tabs
 
I have created a software using this, planning to sell it ;)

Full Zip Hoody 30Sep2010 01:34

Re: VB Script to Compare Two Excel Files with Multiple Tabs
 
i like you script because the ordinary Excel Comparator does the comparison only for single Tabs at one time... but this script compares the number of tabs present in both the excel sheets provided. Works likea charm

carminenatale 1Dec2010 19:29

Re: VB Script to Compare Two Excel Files with Multiple Tabs
 
i am not getting any errors but no results file. please help.


All times are GMT +5.5. The time now is 15:38.