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