1. We have moved from vBulletin to XenForo and you are viewing the site in the middle of the move. Though the functional aspect of everything is working fine, we are still working on other changes including the new design on Xenforo.
    Dismiss Notice

VB Script to Compare Two Excel Files with Multiple Tabs

Discussion in 'Web Design, HTML And CSS Tutorials' started by naimish, Jul 3, 2009.

  1. naimish

    naimish New Member

    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:
    '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
    
     
  2. SaswatPadhi

    SaswatPadhi ~ Б0ЯИ Τ0 С0δЭ ~

    Why do you rate your own articles as 5.00 ??!?

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

    nimesh New Member

    Nice one.
    Few days back someone was asking me if I can write an excel macro to compare to sheets/workbooks :)
     
  4. David Michael

    David Michael New Member

    its easy, you freeze the rows and see what happen.
     
  5. naimish

    naimish New Member

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

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

    Any more clarification ?
     
  6. shabbir

    shabbir Administrator Staff Member

  7. naimish

    naimish New Member

    I have created a software using this, planning to sell it ;)
     
  8. Full Zip Hoody

    Full Zip Hoody New Member

    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
     
  9. carminenatale

    carminenatale New Member

    i am not getting any errors but no results file. please help.
     

Share This Page