Hi experts,
I am new to the forum, Nice to see a good community with so many experts of Excel programming & Macros,
I want to compare two excel workbooks with multiple worksheets each having alphabets, numbers, texts in old file and new file.
The names and order of sheets in old and new file is always the same just some data changes everyday and i want to check on daily basis which data has changed or there is no data changed at all.
Below is the code that i am currently using and i have taken this code from external internet content,
The problem is when i run this code it says unable to find file "olddata.xls" please check the path or correct the filename.
Can you please help me to complete this operation?
' compare an old new to a new file using column B from each worksheet in the two workbooks
' if the old file contains a row that is not in the new file, then add the old data to the
' end of the new file.
' this assumes that the worksheets are all in the same order
Sub CompareandMerge()
Const oldFile As String = "olddata.xls"
Const newFile As String = "newdata.xls"
' open the two workbooks
Dim oldBook As Workbook
Dim newbook As Workbook
Set oldBook = Workbooks.Open(oldFile)
Set newbook = Workbooks.Open(newFile)
' loop through all of the worksheets assuming both workbooks have the same number
' of workheets
Dim i As Long
For i = 1 To oldBook.Worksheets.Count
Dim oldSheet As Worksheet
Dim newSheet As Worksheet
Set oldSheet = oldBook.Worksheets(i)
Set newSheet = newbook.Worksheets(i)
' loop through all of the rows of the old sheet and insert missing rows at the end of the
' new sheet
Dim oldRow As Range
Dim newRow As Range
Dim newRowCounter As Long
newRowCounter = 1
For Each oldRow In oldSheet.Rows
' stop when there is nothing in column B
If (oldRow.Cells(1, "B").Value = "") Then
Exit For
Else
' get the new data at row newRowCounter
Set newRow = newSheet.Rows(newRowCounter)
' compare the old data to the new data
' if not equal, copy the current old row to the end of the new sheet
If (oldRow.Cells(1, "B").Value <> newRow.Cells(1, "B").Value) Then
Dim theNewRow As Long
theNewRow = newSheet.Range("B:B").Rows(newSheet.Range("B:B").Rows.Count).End(xlUp).Row + 1
oldRow.Copy newSheet.Rows(theNewRow)
' hihglight the new row
With newSheet.Rows(theNewRow)
.Interior.ColorIndex = 6
.Interior.Pattern = xlSolid
End With
Else ' increment to the next new row
newRowCounter = newRowCounter + 1
End If
End If
Next oldRow
Next i
End Sub
Bookmarks