Comparing Excel sheets, workbooks

'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

Comparing Two excel files and finding mismatch rows

Set objExcel = CreateObject ("Excel.Application")
objExcel.Visible = True

Set resultWb = objExcel.Workbooks.Add
Set resultWs = resultWb.Worksheets("Sheet1")

resultrow =1
Set objWorkbook1= objExcel.Workbooks.Open("C:\Excel\BI_TEST\TEST_090602_1.xls")
Set objWorkbook2= objExcel.Workbooks.Open("C:\Excel\BI_PROD\PROD_090602_1.xls")

Set objWorksheet1= objWorkbook1.Worksheets(1)
Set objWorksheet2= objWorkbook2.Worksheets(1)
Const xlAscending = 1'represents the sorting type 1 for Ascending 2 for Desc
Const xlYes = 1
'Set objRange =objWorksheet1.UsedRange 'which select the range of the cells has some data other than blank
'Set objRange2 = objWorksheet1.Range("A1") 'select the column to sort

'objRange.Sort objRange2, xlAscending, , , , , , xlYes

'Set objRange12 =objWorksheet2.UsedRange 'which select the range of the cells has some data other than blank
'Set objRange22 = objWorksheet2.Range("A1") 'select the column to sort

'objRange12.Sort objRange22, xlAscending, , , , , , xlYes

resultWs.Cells (resultrow, 1).Value ="Cell Address"
resultWs.Cells (resultrow, 2).Value ="Sheet1 Value"
resultWs.Cells (resultrow, 3).Value ="Sheet2 Value"

dim counter
counter = 0
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
resultrow = resultrow+1
resultWs.Cells (resultrow, 1).Value =cell.Address
resultWs.Cells (resultrow, 2).Value =cell.VALUE
resultWs.Cells (resultrow, 3).Value= objWorksheet2.Range(cell.Address).Value
End If
counter = counter +1
Next

resultWb.SaveAs("C:\Excel\Result\Result_090602_1.xls")