Compare Two ex cel sheets and highlight differences

[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