Compare Two ex cel sheets and highlight differences

[rajrk]

here is your modified function

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
                    If cint(cell.Value) <> cint(objWorksheet2.Range(cell.Address).Value) Then
                            cell.Interior.ColorIndex = 6 'Highlights in red color if any changes in cells
                           ObjExcel.displayAlerts = False
                           objWorkbook1.Save
                    End If
                           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

request you to always wrap your code with proper tags, refer help