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