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

Pages: 1 2

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

You can use Round Function in your statements to round it up to 3 decimal places and compare

Code:
If Round(cell.Value,3) <> Round(objWorksheet2.Range(cell.Address).Value,3) Then

Thank you Saket

I try the update and come back to you.

But I doubt it will fail for some cases when say the data will be like 4.001932 and 4.001134
the Round function will output the 4.002 and 4.001 which wil be wrong.

let me findout some other option.

can you try Mid function, just in case you are getting data from excel as string.

also always wrap up your code with proper tags while posting

Hi Saket

Sorry to say that the code update is compalining where in it come across the text.
Please have a look at the attachment the format of the files we use the above code for comparision.
many thnaks again

Ok , I thought you have only the float data in your file.
Thanks for attaching the xls that you are working on it really helps.

What you need to just skip the cells which dont have float values.
I have tried to modify your function a bit, see if it works for you.
you will need to have a diiferent name for difference excel file because when you will save that it will throw you an error as the same name of file already opened.

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

                            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

let me know if it helps

Hi Saket

Thanks ever so much for the help. I implemented your core logic and customised the function as my req.
it's simply brilliant. I managed to sort the "difference" file/folder issue as well.

Thanks again.
Much appreciated.
maruti

Great!!
Thank you.

Hi Saket

Sorry to bother for reopening a closed issue as I have found issue with the script.
If you had look at the attachment "diff, AFIFILONG" , even though the cell value for "K12" is differed still the script didn't highlight.

If you could be able to look into this issue and input your observations that would be much helpful.

Wait to hear from you
Many thanks in advance

Hi neerukonda9,

this will not highlight the value in cell K12 as the value upto three decimal place is same ie - .057. refer your query in the first post, your requirement was to validate the value upto three decimal place.
if you want to check the values before decimal as well then append the code below in your script in for loop.

Code:
If cint(cell.Value) <> cint(objWorksheet2.Range(cell.Address).Value) Then

                            cell.Interior.ColorIndex = 6 

                            ObjExcel.displayAlerts = False

                            objWorkbook1.Save

                    End If

Pages: 1 2