'Call CompareExcelAndProvideResultInAnotherSheet("C:\Documents and Settings\Metson\Desktop\test Excel\Book2.xls", "C:\Documents and Settings\Metson\Desktop\test Excel\Book1.xls")
'Call Compare2ExcelsCellByCell("C:\Documents and Settings\Metson\Desktop\test Excel\Book2.xls", "C:\Documents and Settings\Metson\Desktop\test Excel\Book1.xls")
Call Compare2ExcelsCellByCell("C:\Jackson-Works\BIChangedTxt\Test_USAGE_090602.csv", "C:\Jackson-Works\BIChangedTxt\POM_ADHOC_090602.csv")
Msgbox "Done Comparing Results"
Function CompareExcelAndProvideResultInAnotherSheet(inputFile1, inputFile2)
Set objExcel=CreateObject("Excel.Application")
objExcel.Visible=True
Set objWorkBook1=objExcel.Workbooks.Open(inputFile1)
Set objWorkBook2=objExcel.Workbooks.Open(inputFile2)
msgbox objWorkBook1.Worksheets.count
Set objWorksheet1=objWorkBook1.Worksheets(1)
Set objWorkSheet2=objWorkBook2.Worksheets(1)
For each cell in objWorkSheet1.UsedRange
c1=cell.Value
c2=objWorksheet2.Range(cell.Address).Value
Set rc=New RegExp
rc.Pattern=c1
rc.IgnoreCase=True
rc.Global=True
'Msgbox s
'Msgbox ptn
'MsgbOx rc.Test(s)
If rc.Test(c2) Then
cell.Value="Pass"
'c2.Interior.ColorIndex = 0
Else
' cell.Value= "Fail"
c2.Interior.ColorIndex = 3
End If
Next
Set objExcel=Nothing
End Function
Msgbox "Done"
Function Compare2ExcelsCellByCell(inputFile1, inputFile2)
'Compare 2 Excel sheets cell by cell and making the cell background as Red for the unmatched Cell value
'=============================================
'This code will open two excel sheet and compare each sheet cell by cell, if any changes there in cells , it will highlight the cells in red color in the first sheet.
Set objExcel = CreateObject("Excel.Application")
'objExcel.Visible = True
Set objWorkBook1=objExcel.Workbooks.Open(inputFile1)
Set objWorkBook2=objExcel.Workbooks.Open(inputFile2)
msgbox objWorkBook1.Worksheets.count
For i = 1 to objWorkBook1.Worksheets.count
If (objWorkBook1.Worksheets(i).UsedRange.Rows.Count=1) And (objWorkBook1.Worksheets(i).UsedRange.Columns.Count=1)Then
objWorkBook1.Worksheets(i).Delete
End If
Next
For i = 1 to objWorkBook2.Worksheets.count
If (objWorkBook2.Worksheets(i).UsedRange.Rows.Count=1) And (objWorkBook2.Worksheets(i).UsedRange.Columns.Count=1)Then
objWorkBook1.Worksheets(i).Delete
End If
Next
Set objWorksheet1=objWorkBook1.Worksheets(1)
Set objWorkSheet2=objWorkBook2.Worksheets(1)
For Each cell In objWorksheet1.UsedRange
If cell.Value <> objWorksheet2.Range(cell.Address).Value Then
cell.Interior.ColorIndex = 3 'Highlights in red color if any changes in cells
Else
cell.Interior.ColorIndex = 5
End If
Next
objWorkBook1.Save
objWorkBook2.Save
objExcel.Quit
set objExcel=nothing
End Function
No comments:
Post a Comment