Micro Focus QTP (UFT) Forums
Compare Two ex cel sheets and highlight differences - Printable Version

+- Micro Focus QTP (UFT) Forums (https://www.learnqtp.com/forums)
+-- Forum: Micro Focus UFT (earlier known as QTP) (https://www.learnqtp.com/forums/Forum-Micro-Focus-UFT-earlier-known-as-QTP)
+--- Forum: UFT / QTP Beginners (https://www.learnqtp.com/forums/Forum-UFT-QTP-Beginners)
+--- Thread: Compare Two ex cel sheets and highlight differences (/Thread-Compare-Two-ex-cel-sheets-and-highlight-differences)

Pages: 1 2

RE: Compare Two ex cel sheets and highlight differences - neerukonda9 - 11-03-2009

Hi Saket

Thank you for the reply. Unfortunately I didn't pick up where to amend the code. I tried different combinations resulting in different errors. Appreciate if you could amend the below code with the previous input.

My apologies for being painful
many thanks
maruti
---------------------------------
Code:
Function excel_comp_threedec

expectedfolder = environment("expfld")

actualfolder =  environment("actfld")

difffolder = environment("difffld")

Dim fso, f, fc, f1

   Set fso = CreateObject("Scripting.FileSystemObject")

   Set f = fso.GetFolder(expectedfolder)

   Set fc = f.Files

   For Each f1 in fc

   expectedfile = expectedfolder +  f1.name
   actualfile = actualfolder +  replace(f1.Name,".xls","a.xls")

Set WSShell = CreateObject("WScript.shell")
Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = False
ObjExcel.displayAlerts = False

Set objWorkbook2= objExcel.Workbooks.Open(expectedfile)

Set objWorkbook1= objExcel.Workbooks.Open(actualfile)

'objWorkbook1.SaveAs DifferenceFile

WScount1=objWorkbook1.Worksheets.Count
WScount2=objWorkbook2.Worksheets.Count

If WScount1<>WScount2 Then
WSShell.Popup "Number of worksheets in file 1 is not equal to Number of worksheets in file 2", 2

Else
For I = 1 To WScount1
Set objWorksheet1= objWorkbook1.Worksheets(I)
Set objWorksheet2= objWorkbook2.Worksheets(I)

For Each cell In objWorksheet1.UsedRange
    cell.Select
    If cell.value <> "" Then
                If instr(1,cell.value,".") Then
                            iPos= instr(1,cell.value,".")+1
                            If mid(cell.Value,iPos,4) <> mid(objWorksheet2.Range(cell.Address).Value,iPos,4) Then
                                    cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                                    ObjExcel.displayAlerts = False
                                    objWorkbook1.Save
                            end if
                else
                            If cell.Value <> objWorksheet2.Range(cell.Address).Value Then
                                    cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                                    ObjExcel.displayAlerts = False
                                    objWorkbook1.SaveAs difffolder + f1.name
                            Else
                                    cell.Interior.ColorIndex = 0
                            End If
                End If
    End If

Next

Next

objExcel.Save

Set objWorksheet1= Nothing
Set objWorksheet2= Nothing
objExcel.Application.Quit

End if
next
Set objExcel=Nothing

end function
-----------------------------------------------------------------

RE: Compare Two ex cel sheets and highlight differences - Saket - 11-04-2009

here is your modified function
Code:
Function excel_comp

expectedfolder = environment("expfld")

actualfolder = environment("actfld")

difffolder = environment("difffld")

Dim fso, f, fc, f1

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder(expectedfolder)

Set fc = f.Files

For Each f1 in fc

expectedfile = expectedfolder + f1.name
actualfile = actualfolder + replace(f1.Name,".xls","a.xls")

DifferenceFile = difffolder + replace(f1.Name,".xls","d.xls")

Set WSShell = CreateObject("WScript.shell")

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = true
ObjExcel.displayAlerts = False

Set objWorkbook2= objExcel.Workbooks.Open(expectedfile)

Set objWorkbook1= objExcel.Workbooks.Open(actualfile)

objWorkbook1.SaveAs DifferenceFile

WScount1=objWorkbook1.Worksheets.Count
WScount2=objWorkbook2.Worksheets.Count

If WScount1<>WScount2 Then
WSShell.Popup "Number of worksheets in file 1 is not equal to Number of worksheets in file 2", 2

Else
For I = 1 To WScount1
Set objWorksheet1= objWorkbook1.Worksheets(I)
Set objWorksheet2= objWorkbook2.Worksheets(I)

For Each cell In objWorksheet1.UsedRange
    cell.Select
    If cell.value <> "" Then
        
                If instr(1,cell.value,".") Then
                    If cint(cell.Value) <> cint(objWorksheet2.Range(cell.Address).Value) Then
                            cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                            ObjExcel.displayAlerts = False
                            objWorkbook1.Save
                    End If
                            iPos= instr(1,cell.value,".")+1
                            If mid(cell.Value,iPos,3) <> mid(objWorksheet2.Range(cell.Address).Value,iPos,3) Then
                                    cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                                    ObjExcel.displayAlerts = False
                                    objWorkbook1.Save
                            end if
                else
                            If cell.Value <> objWorksheet2.Range(cell.Address).Value Then
                                    cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                                    ObjExcel.displayAlerts = False
                                    objWorkbook1.Save
                            Else
                                    cell.Interior.ColorIndex = 0
                            End If
                End If
    End If

Next

Next

objExcel.Save

Set objWorksheet1= Nothing
Set objWorksheet2= Nothing
objExcel.Application.Quit

End if
next
Set objExcel=Nothing

end function
request you to always wrap your code with proper tags, refer help

RE: Compare Two ex cel sheets and highlight differences - neerukonda9 - 11-06-2009

Hi Saket
Thank you for the updated code. But still I am experiencing new issues "Overflow". Please have a look at attachment.

Wait to hear from you
Many thanks in advance
maruti

RE: Compare Two ex cel sheets and highlight differences - Saket - 11-06-2009

I guess you are getting this error where the cell values are like 3120952.2 or 1.00343E+14.
The reason behind this is CInt() has an upper and lower bound. It will only allow you to convert to a integer value between -32,768 and 32,768.
Try if you can Int() with this you can go upto 1E+208. But again, It will have issue with -ve numbers, it truncates to lowest decimal.
or else see if direct comparison works in your case, ie compare the whole cell value.
I guess you are getting this error where the cell values are like 3120952.2 or 1.00343E+14.
The reason behind this is CInt() has an upper and lower bound. It will only allow you to convert to a integer value between -32,768 and 32,768.
Try if you can Int() with this you can go upto 1E+208. But again, It will have issue with -ve numbers, it truncates to lowest decimal.
or else see if direct comparison works in your case, ie compare the whole cell value.

RE: Compare Two ex cel sheets and highlight differences - neerukonda9 - 11-06-2009

Hi Saket
Much appreciate you help. Unfortunately "int" is not working. So I used "Round" function still code is compalining at the "string level".
Please have a look at attachment for more details.
Wait to hear from you.

Many thanks as usual in advance
maruti

RE: Compare Two ex cel sheets and highlight differences - vijaychourasiya0109@gmail.com - 03-02-2020

(10-01-2009, 03:24 PM)neerukonda9 Wrote: Guys

I am looking at upgrading the below script for comparing two excel sheets in a way that the differences will be highlightled only when the data in the cells differ after three decimal places.

example: cell 1 --- 3.00123; cell 2--- 3.00132

I don't want to hightlight the above difference as there is no difference upto three decimals.

Any quick response is much appreciated.

many thanks in advance.


I am looking at upgrading the

Code:
Function excel_comp

expectedfolder = environment("expfld")

actualfolder = environment("actfld")

difffolder = environment("difffld")

Dim fso, f, fc, f1

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder(expectedfolder)

Set fc = f.Files

For Each f1 in fc

expectedfile = expectedfolder + f1.name
actualfile = actualfolder + replace(f1.Name,".xls","a.xls")

Set WSShell = CreateObject("WScript.shell")

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = false

Set objWorkbook2= objExcel.Workbooks.Open(expectedfile)

Set objWorkbook1= objExcel.Workbooks.Open(actualfile)

WScount1=objWorkbook1.Worksheets.Count
WScount2=objWorkbook2.Worksheets.Count

If WScount1<>WScount2 Then
WSShell.Popup "Number of worksheets in file 1 is not equal to Number of worksheets in file 2", 2

Else
For I = 1 To WScount1
Set objWorksheet1= objWorkbook1.Worksheets(I)
Set objWorksheet2= objWorkbook2.Worksheets(I)

For Each cell In objWorksheet1.UsedRange
If cell.Value <> objWorksheet2.Range(cell.Address).Value Then
cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
ObjExcel.displayAlerts = False
objWorkbook1.SaveAs difffolder + f1.name
objExcel.Save

Else
cell.Interior.ColorIndex = 0
End If
Next

Next
ObjExcel.displayAlerts = False
objExcel.Save

Set objWorksheet1= Nothing
Set objWorksheet2= Nothing
objExcel.Application.Quit

End if
next
Set objExcel=Nothing

end function
Set objMyExcel = CreateObject("Excel.Application")
objMyExcel.Visible = False

Set objMyDataExcel1= objMyExcel.Workbooks.Open("C:\Users\chourasiyav\Desktop\sample\File 2.xlsx")
Set objMyDataExcel2= objMyExcel.Workbooks.Open("C:\Users\chourasiyav\Desktop\sample\File3.xlsx")

Set objMyWorksheet1= objMyDataExcel1.Worksheets(3)
Set objMyWorksheet2= objMyDataExcel2.Worksheets(3)

For Each cell In objMyWorksheet1.UsedRange

'if the found unique value/Unmatched value then hightlight row in the red color
   If cell.Value <> objMyWorksheet2.Range(cell.Address).Value Then
       objMyWorksheet2.Range(cell.Address).Value = cell.Value
       cell.Interior.ColorIndex = 3

   Else

       cell.Interior.ColorIndex = 0

   End If

 Next

Set objMyExcel = Nothing
objMyDataExcel1.SaveAs("C:\Users\chourasiyav\Desktop\sample\File4.xlsx")
wait 2
objMyDataExcel1.Close

RE: Compare Two ex cel sheets and highlight differences - rajrk - 06-02-2020

Hi Saket - This work fine for first work Sheet of Excel file. Once first sheet comparison done, when script moved to 2nd work sheet comparison, it is throwing a range class error at " cell.Select". Can you modify code so that it can move to other excel sheets of Excel file for comparison of cell data
Code:
Function excel_comp

expectedfolder = environment("expfld")

actualfolder = environment("actfld")

difffolder = environment("difffld")

Dim fso, f, fc, f1

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder(expectedfolder)

Set fc = f.Files

For Each f1 in fc

expectedfile = expectedfolder + f1.name
actualfile = actualfolder + replace(f1.Name,".xls","a.xls")

DifferenceFile = difffolder + replace(f1.Name,".xls","d.xls")

Set WSShell = CreateObject("WScript.shell")

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = true
ObjExcel.displayAlerts = False

Set objWorkbook2= objExcel.Workbooks.Open(expectedfile)

Set objWorkbook1= objExcel.Workbooks.Open(actualfile)

objWorkbook1.SaveAs DifferenceFile

WScount1=objWorkbook1.Worksheets.Count
WScount2=objWorkbook2.Worksheets.Count

If WScount1<>WScount2 Then
WSShell.Popup "Number of worksheets in file 1 is not equal to Number of worksheets in file 2", 2

Else
For I = 1 To WScount1
Set objWorksheet1= objWorkbook1.Worksheets(I)
Set objWorksheet2= objWorkbook2.Worksheets(I)

For Each cell In objWorksheet1.UsedRange
   cell.Select
   If cell.value <> "" Then
        
               If instr(1,cell.value,".") Then
                    If cint(cell.Value) <> cint(objWorksheet2.Range(cell.Address).Value) Then
                            cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                           ObjExcel.displayAlerts = False
                           objWorkbook1.Save
                    End If
                           iPos= instr(1,cell.value,".")+1
                           If mid(cell.Value,iPos,3) <> mid(objWorksheet2.Range(cell.Address).Value,iPos,3) Then
                                   cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                                   ObjExcel.displayAlerts = False
                                   objWorkbook1.Save
                           end if
               else
                           If cell.Value <> objWorksheet2.Range(cell.Address).Value Then
                                   cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                                   ObjExcel.displayAlerts = False
                                   objWorkbook1.Save
                           Else
                                   cell.Interior.ColorIndex = 0
                           End If
               End If
   End If

Next

Next

objExcel.Save

Set objWorksheet1= Nothing
Set objWorksheet2= Nothing
objExcel.Application.Quit

End if
next
Set objExcel=Nothing

end function
request you to always wrap your code with proper tags, refer help

RE: Compare Two ex cel sheets and highlight differences - rajrk - 06-03-2020

(11-04-2009, 09:47 AM)Hi Saket, Unfortunately, Comparison of Cell data fails when script jumps to NEXT Sheet of Excel . The Error is " Select method of Range class failed ". Can you correct this code ??? Wrote: here is your modified function
Code:
Function excel_comp

expectedfolder = environment("expfld")

actualfolder = environment("actfld")

difffolder = environment("difffld")

Dim fso, f, fc, f1

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder(expectedfolder)

Set fc = f.Files

For Each f1 in fc

expectedfile = expectedfolder + f1.name
actualfile = actualfolder + replace(f1.Name,".xls","a.xls")

DifferenceFile = difffolder + replace(f1.Name,".xls","d.xls")

Set WSShell = CreateObject("WScript.shell")

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = true
ObjExcel.displayAlerts = False

Set objWorkbook2= objExcel.Workbooks.Open(expectedfile)

Set objWorkbook1= objExcel.Workbooks.Open(actualfile)

objWorkbook1.SaveAs DifferenceFile

WScount1=objWorkbook1.Worksheets.Count
WScount2=objWorkbook2.Worksheets.Count

If WScount1<>WScount2 Then
WSShell.Popup "Number of worksheets in file 1 is not equal to Number of worksheets in file 2", 2

Else
For I = 1 To WScount1
Set objWorksheet1= objWorkbook1.Worksheets(I)
Set objWorksheet2= objWorkbook2.Worksheets(I)

For Each cell In objWorksheet1.UsedRange
   cell.Select
   If cell.value <> "" Then
        
               If instr(1,cell.value,".") Then
                    If cint(cell.Value) <> cint(objWorksheet2.Range(cell.Address).Value) Then
                            cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                           ObjExcel.displayAlerts = False
                           objWorkbook1.Save
                    End If
                           iPos= instr(1,cell.value,".")+1
                           If mid(cell.Value,iPos,3) <> mid(objWorksheet2.Range(cell.Address).Value,iPos,3) Then
                                   cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                                   ObjExcel.displayAlerts = False
                                   objWorkbook1.Save
                           end if
               else
                           If cell.Value <> objWorksheet2.Range(cell.Address).Value Then
                                   cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                                   ObjExcel.displayAlerts = False
                                   objWorkbook1.Save
                           Else
                                   cell.Interior.ColorIndex = 0
                           End If
               End If
   End If

Next

Next

objExcel.Save

Set objWorksheet1= Nothing
Set objWorksheet2= Nothing
objExcel.Application.Quit

End if
next
Set objExcel=Nothing

end function
request you to always wrap your code with proper tags, refer help