Original date: 19 Jan 2009, 2:00pm

Parent page: Service Functions – Excel (QTP, VBScript)

Excel application must be installed on the PC.
Comparison goes cell by cell within the occupied range.
Marks mismatching cells red.

Both workbooks must exist and be defined as the full path with file.
Both worksheets must exist and may be defined as a numeric index or string name.

objParameter is a reserved parameter to implement custom comparison like “ignore case”, “round up numbers”, etc.

Public Function ExcelWorksheetCompare(ByVal sWorkbook1, ByVal sWorksheet1, ByVal sWorkbook2, ByVal sWorksheet2, ByVal objParameter)
 Dim boolRC, boolSheetExists
 Dim FSO, XLHandle
 Dim XLBook1, XLBook2, XLSheet1, XLSheet2
 Dim Iter, objCell
 'Verify both files exist
 Set FSO = CreateObject("Scripting.FileSystemObject")
 boolRC = FSO.FileExists(sWorkbook1)
 If Not boolRC Then
 Set FSO = Nothing
 ExcelWorksheetCompare = FALSE
 Exit Function
 End If
 boolRC = FSO.FileExists(sWorkbook2)
 If Not boolRC Then
 Set FSO = Nothing
 ExcelWorksheetCompare = FALSE
 Exit Function
 End If
 Set FSO = Nothing
 Set XLHandle = CreateObject("Excel.Application")
 XLHandle.DisplayAlerts = False
 'Open workbook1
 Set XLBook1 = XLHandle.WorkBooks.Open(sWorkbook1)
 'Verify sheet exists (1)
 If isNumeric(sWorksheet1) Then
 sWorksheet1 = CInt(sWorksheet1)
 If (sWorksheet1 >0) AND (sWorksheet1<=XLBook1.Worksheets.Count) Then
 Set XLSheet1 = XLBook1.Worksheets(sWorksheet1)
 boolSheetExists = TRUE
 Else
 boolSheetExists = FALSE
 End If
 Else
 boolSheetExists = FALSE
 For Iter = 1To XLBook1.Worksheets.Count
 If XLBook1.Worksheets(Iter).Name = sWorksheet1 Then
 Set XLSheet1 = XLBook1.Worksheets(Iter)
 boolSheetExists = TRUE
 End If
 Next
 End If
 If Not boolSheetExists Then
 XLBook1.Close
 XLHandle.Quit
 Set XLBook1 = Nothing
 Set XLHandle = Nothing
 ExcelWorksheetCompare = FALSE
 Exit Function
 End If
 'Open workbook2
 Set XLBook2 = XLHandle.WorkBooks.Open(sWorkbook2)
 'Verify sheet exists (2)
 If isNumeric(sWorksheet2) Then
 sWorksheet2 = CInt(sWorksheet2)
 If (sWorksheet2 >0) AND (sWorksheet2<=XLBook2.Worksheets.Count) Then
 Set XLSheet2 = XLBook2.Worksheets(sWorksheet2)
 boolSheetExists = TRUE
 Else
 boolSheetExists = FALSE
 End If
 Else
 boolSheetExists = FALSE
 For Iter = 1To XLBook2.Worksheets.Count
 If XLBook2.Worksheets(Iter).Name = sWorksheet2 Then
 Set XLSheet2 = XLBook2.Worksheets(Iter)
 boolSheetExists = TRUE
 End If
 Next
 End If
 If Not boolSheetExists Then
 XLBook1.Close
 XLBook2.Close
 XLHandle.Quit
 Set XLSheet1 = Nothing
 Set XLBook1 = Nothing
 Set XLBook2 = Nothing
 Set XLHandle = Nothing
 ExcelWorksheetCompare = FALSE
 Exit Function
 End If
 'Mark range
 'Compare and mark mismatches red
 For Each objCell In XLSheet2.UsedRange
 If objCell.Value <> XLSheet1.Range(objCell.Address).Value Then
 objCell.Interior.ColorIndex = 3
 Else
 objCell.Interior.ColorIndex = 0
 End If
 Next
 'Save and close
 XLBook1.Close
 XLBook2.Save
 XLBook2.Close
 XLHandle.Quit
 Set XLSheet1 = Nothing
 Set XLSheet2 = Nothing
 Set XLBook1 = Nothing
 Set XLBook2 = Nothing
 Set XLHandle = Nothing
 ExcelWorksheetCompare = TRUE
End Function