Thank you for the reply. Unfortunately I didn't pick up where to amend the code. I tried different combinations resulting in different errors. Appreciate if you could amend the below code with the previous input.
My apologies for being painful
many thanks
maruti
---------------------------------
Code:
Function excel_comp_threedec
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
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,4) <> mid(objWorksheet2.Range(cell.Address).Value,iPos,4) 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.SaveAs difffolder + f1.name
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
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
11-06-2009, 05:42 PM (This post was last modified: 11-06-2009, 05:43 PM by Saket.)
I guess you are getting this error where the cell values are like 3120952.2 or 1.00343E+14.
The reason behind this is CInt() has an upper and lower bound. It will only allow you to convert to a integer value between -32,768 and 32,768.
Try if you can Int() with this you can go upto 1E+208. But again, It will have issue with -ve numbers, it truncates to lowest decimal.
or else see if direct comparison works in your case, ie compare the whole cell value.
I guess you are getting this error where the cell values are like 3120952.2 or 1.00343E+14.
The reason behind this is CInt() has an upper and lower bound. It will only allow you to convert to a integer value between -32,768 and 32,768.
Try if you can Int() with this you can go upto 1E+208. But again, It will have issue with -ve numbers, it truncates to lowest decimal.
or else see if direct comparison works in your case, ie compare the whole cell value.
Hi Saket
Much appreciate you help. Unfortunately "int" is not working. So I used "Round" function still code is compalining at the "string level".
Please have a look at attachment for more details.
Wait to hear from you.
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
Set objMyExcel =CreateObject("Excel.Application")
objMyExcel.Visible =False
Set objMyDataExcel1= objMyExcel.Workbooks.Open("C:\Users\chourasiyav\Desktop\sample\File 2.xlsx") Set objMyDataExcel2= objMyExcel.Workbooks.Open("C:\Users\chourasiyav\Desktop\sample\File3.xlsx")
Set objMyWorksheet1= objMyDataExcel1.Worksheets(3) Set objMyWorksheet2= objMyDataExcel2.Worksheets(3)
ForEach cell In objMyWorksheet1.UsedRange
'if the found unique value/Unmatched value then hightlight row in the red color If cell.Value <> objMyWorksheet2.Range(cell.Address).Value Then
objMyWorksheet2.Range(cell.Address).Value = cell.Value
cell.Interior.ColorIndex =3
Else
cell.Interior.ColorIndex =0
EndIf
Next
Set objMyExcel =Nothing
objMyDataExcel1.SaveAs("C:\Users\chourasiyav\Desktop\sample\File4.xlsx") wait2
objMyDataExcel1.Close
Hi Saket - This work fine for first work Sheet of Excel file. Once first sheet comparison done, when script moved to 2nd work sheet comparison, it is throwing a range class error at " cell.Select". Can you modify code so that it can move to other excel sheets of Excel file for comparison of cell data
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
(11-04-2009, 09:47 AM)Hi Saket, Unfortunately, Comparison of Cell data fails when script jumps to NEXT Sheet of Excel . The Error is " Select method of Range class failed ". Can you correct this code ??? Wrote: 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
