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