Compare Two ex cel sheets and highlight differences

[neerukonda9]

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

[Saket]

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

[neerukonda9]

Thank you Saket

I try the update and come back to you.

[Saket]

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

[neerukonda9]

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

[Saket]

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

[neerukonda9]

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

[Saket]

Great!!
Thank you.

[neerukonda9]

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

[Saket]

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