QTP- COmpare excel sheets

'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 < style="color: rgb(0, 0, 255);">Then

   maxR = x2

  End If

  If maxC < style="color: rgb(0, 0, 255);">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