VB Script to Compare Two Excel Files with Multiple Tabs

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

  1. naimish

    naimish New Member

    Joined:
    Jun 29, 2009
    Messages:
    1,043
    Likes Received:
    18
    Trophy Points:
    0
    Occupation:
    Software Engineer
    Location:
    On Earth

    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δЭ ~

    Joined:
    May 5, 2009
    Messages:
    1,342
    Likes Received:
    55
    Trophy Points:
    0
    Occupation:
    STUDENT !
    Location:
    Orissa, INDIA
    Home Page:
    http://www.crackingforfun.blogspot.com
    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

    Joined:
    Apr 13, 2009
    Messages:
    769
    Likes Received:
    20
    Trophy Points:
    0
    Occupation:
    Oracle Apps Admin
    Location:
    Mumbai
    Home Page:
    http://techiethakkar.blogspot.com
    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

    Joined:
    Jul 6, 2009
    Messages:
    10
    Likes Received:
    0
    Trophy Points:
    0
    its easy, you freeze the rows and see what happen.
     
  5. naimish

    naimish New Member

    Joined:
    Jun 29, 2009
    Messages:
    1,043
    Likes Received:
    18
    Trophy Points:
    0
    Occupation:
    Software Engineer
    Location:
    On Earth
    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

    Joined:
    Jul 12, 2004
    Messages:
    15,375
    Likes Received:
    388
    Trophy Points:
    83
  7. naimish

    naimish New Member

    Joined:
    Jun 29, 2009
    Messages:
    1,043
    Likes Received:
    18
    Trophy Points:
    0
    Occupation:
    Software Engineer
    Location:
    On Earth
    I have created a software using this, planning to sell it ;)
     
  8. Full Zip Hoody

    Full Zip Hoody New Member

    Joined:
    Sep 29, 2010
    Messages:
    20
    Likes Received:
    0
    Trophy Points:
    0
    Occupation:
    Programer
    Location:
    US of A
    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

    Joined:
    Dec 1, 2010
    Messages:
    1
    Likes Received:
    0
    Trophy Points:
    0
    i am not getting any errors but no results file. please help.
     
  10. laksh

    laksh New Member

    Joined:
    Aug 30, 2016
    Messages:
    1
    Likes Received:
    0
    Trophy Points:
    1
    Gender:
    Male
    did not work in larger files? any help will be appreciated!!
     

Share This Page

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice