Search This Blog

Welcome to Machers Blog

Blogging the world of Technology and Testing which help people to build their career.

Monday, October 3, 2011

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

No comments: