VBA Compare Excel Files Macro

[colm.smyth]

Hi all,

Hope you can help me, i am no expert and not brilliant with VBA but i managed to clobber some code together and with help from online sources a very nice script that i now need help to modify a bit.

Basically the code will compare two excel files and for identical rows between files pull out comments from a "Comments" column on the old into the "Comments" column on the new.

I have had a request to see if the code could highlight the brand new rows in one colour and the modified rows in a different. I have pasted the current code below. I have also attached two example excel files that you can run it on, i think i can only post one file but ill see

I hope you can help,

Regards

Colm

[VBA]Sub CopyCommentsForward()
Dim wbkOld As Workbook, wbkNew As Workbook
Dim varOldWb, varNewWb, varSourceData
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim strSheetName As String, strFirstAddress As String
Dim lngCommentColumn As Long, lngCounter As Long, lngRowCount As Long
Dim blnMismatch As Boolean
Dim rngFinder As Range, rngSourceData As Range, rngCell As Range
varOldWb = Application.GetOpenFilename("Microsoft Excel Files (*.xlsx), *.xlsx", , "Select workbook for last data set")
If varOldWb <> False Then
Set wbkOld = Workbooks.Open(varOldWb)
End If
varNewWb = Application.GetOpenFilename("Microsoft Excel Files (*.xlsx), *.xlsx", , "Select workbook for current data set")
If varNewWb <> False Then
Set wbkNew = Workbooks.Open(varNewWb)
End If
Application.ScreenUpdating = False
For Each wksSource In wbkOld.Worksheets
strSheetName = wksSource.Name
On Error Resume Next
' Check same sheet exists in new workbook
Set wksTarget = wbkNew.Worksheets(strSheetName)
If Not wksTarget Is Nothing Then
lngCommentColumn = wksSource.Range("IV1").End(xlToLeft).Column
Set rngSourceData = wksSource.Columns(lngCommentColumn).SpecialCells(xlCellTypeConstants)
For Each rngCell In rngSourceData
Set rngFinder = wksTarget.Columns(1).Find(What:=wksSource.Cells(rngCell.Row, 1), lookat:=xlWhole)
If Not rngFinder Is Nothing Then
strFirstAddress = rngFinder.Address
Do
blnMismatch = False
For lngCounter = 1 To lngCommentColumn - 2
If rngFinder.Offset(0, lngCounter) <> wksSource.Cells(rngCell.Row, 1).Offset(0, lngCounter) Then
blnMismatch = True
Exit For
End If
Next lngCounter
If Not blnMismatch Then
wksTarget.Cells(rngFinder.Row, lngCommentColumn) = rngCell
Else
Set rngFinder = wksTarget.Columns(1).FindNext(rngFinder)
End If
Loop While blnMismatch = True And rngFinder.Address <> strFirstAddress And Not rngFinder Is Nothing
End If
Next rngCell
End If
Next wksSource
wbkNew.Save
wbkNew.Close
wbkOld.Close False
Application.ScreenUpdating = True
Set wksSource = Nothing
Set wksTarget = Nothing
Set wbkNew = Nothing
Set wbkOld = Nothing
End Sub[/VBA]

[colm.smyth]

Here is the other sample file

[mdmackillop]

I have had a request to see if the code could highlight the brand new rows in one colour and the modified rows in a different.

Where do new rows come from?

[colm.smyth]

the rows come from the two files attached, old was run last week and new this week, new contains eveything in old plus new data. The macro pulls the comments from old in the comments column into the new.xlsx file for the same rows, everything else is new or changed, these should highlight.

Where do new rows come from?

[GTO]

Greetings Colm,

With some junk copies of the workbooks, try this.

Please note to change the extensions back to 2007 type.

Also - I didn't want to get too far before checking one thing. When determining a record to be new, can we count on AETerm for unique values - and - will these always be in Col E?
[vba]
Option Explicit

Sub CopyCommentsForward()
Dim wbkOld As Workbook, wbkNew As Workbook
Dim varOldWb, varNewWb, varSourceData
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim strSheetName As String, strFirstAddress As String
Dim lngCommentColumn As Long, lngCounter As Long, lngRowCount As Long
Dim blnMismatch As Boolean
Dim rngFinder As Range, rngSourceData As Range, rngCell As Range

Dim rngAETermNew As Range, rngAETermOld As Range, rngFindMatch As Range

'// just cuz I'm in 2000/2003 - CHANGE BACK to .xlsx//
varOldWb = Application.GetOpenFilename( _
"Microsoft Excel Files (*.xls), *.xls", , "Select workbook for last data set")


If varOldWb <> False Then
Set wbkOld = Workbooks.Open(varOldWb)
End If
'// SAA//
varNewWb = Application.GetOpenFilename( _
"Microsoft Excel Files (*.xls), *.xls", , "Select workbook for current data set")

If varNewWb <> False Then
Set wbkNew = Workbooks.Open(varNewWb)
End If

Application.ScreenUpdating = False

For Each wksSource In wbkOld.Worksheets
strSheetName = wksSource.Name
On Error Resume Next
' Check same sheet exists in new workbook
Set wksTarget = wbkNew.Worksheets(strSheetName)
If Not wksTarget Is Nothing Then
lngCommentColumn = wksSource.Range("IV1").End(xlToLeft).Column

'// If Row 1 is always a header, maybe start checking at Row 2
'Set rngSourceData = wksSource.Columns(lngCommentColumn) _
.SpecialCells(xlCellTypeConstants)
Set rngSourceData = _
wksSource.Range(wksSource.Cells(2, lngCommentColumn), _
wksSource.Cells(Rows.Count, lngCommentColumn)) _
.SpecialCells(xlCellTypeConstants)

'// Only if Col 5 (E) can be counted on to be unique identifier for the //
'// record... Set references to these in both the new and old wb's //
Set rngAETermNew = _
wksTarget.Range("E2:E" & wksTarget.Cells(Rows.Count, "E").End(xlUp).Row)
Set rngAETermOld = _
wksSource.Range("E2:E" & wksSource.Cells(Rows.Count, "E").End(xlUp).Row)

'// for each ID in the new wb... //
For Each rngCell In rngAETermNew
'// see if we find the same AETerm in the old wb.//
Set rngFindMatch = rngAETermOld.Find(What:=rngCell.Value, _
After:=rngAETermOld(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
'// rngFindMatch will return Nothing if not found in the old wb, so we //
'// know its a new record. //
If rngFindMatch Is Nothing Then
rngCell.Offset(, -4).Resize(, 5).Interior.ColorIndex = 6
End If
Next

For Each rngCell In rngSourceData
Set rngFinder = wksTarget.Columns(1).Find( _
What:=wksSource.Cells(rngCell.Row, 1), LookAt:=xlWhole)
If Not rngFinder Is Nothing Then
strFirstAddress = rngFinder.Address
Do
blnMismatch = False
For lngCounter = 1 To lngCommentColumn - 2
If rngFinder.Offset(0, lngCounter) <> _
wksSource.Cells(rngCell.Row, 1).Offset(0, lngCounter) Then

blnMismatch = True
Exit For
End If
Next lngCounter
If Not blnMismatch Then
wksTarget.Cells(rngFinder.Row, lngCommentColumn) = rngCell
Else
Set rngFinder = wksTarget.Columns(1).FindNext(rngFinder)
End If
Loop While blnMismatch = True _
And rngFinder.Address <> strFirstAddress _
And Not rngFinder Is Nothing
End If
Next rngCell
End If
Next wksSource
wbkNew.Save
wbkNew.Close
wbkOld.Close False
Application.ScreenUpdating = True
Set wksSource = Nothing
Set wksTarget = Nothing
Set wbkNew = Nothing
Set wbkOld = Nothing
End Sub
[/vba]

Hope this helps,

Mark

[colm.smyth]

Hi Mark,

O hope i have not confused you in my OP, but the code i supplied already works and pull accross the comments for identical rows, but i just want to now have the code highlight what the changed cells are on the rows that no comment came accross for, do you know what i mean ?

Greetings Colm,

With some junk copies of the workbooks, try this.

Please note to change the extensions back to 2007 type.

Also - I didn't want to get too far before checking one thing. When determining a record to be new, can we count on AETerm for unique values - and - will these always be in Col E?
[vba]
Option Explicit

Sub CopyCommentsForward()
Dim wbkOld As Workbook, wbkNew As Workbook
Dim varOldWb, varNewWb, varSourceData
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim strSheetName As String, strFirstAddress As String
Dim lngCommentColumn As Long, lngCounter As Long, lngRowCount As Long
Dim blnMismatch As Boolean
Dim rngFinder As Range, rngSourceData As Range, rngCell As Range

Dim rngAETermNew As Range, rngAETermOld As Range, rngFindMatch As Range

'// just cuz I'm in 2000/2003 - CHANGE BACK to .xlsx//
varOldWb = Application.GetOpenFilename( _
"Microsoft Excel Files (*.xls), *.xls", , "Select workbook for last data set")


If varOldWb <> False Then
Set wbkOld = Workbooks.Open(varOldWb)
End If
'// SAA//
varNewWb = Application.GetOpenFilename( _
"Microsoft Excel Files (*.xls), *.xls", , "Select workbook for current data set")

If varNewWb <> False Then
Set wbkNew = Workbooks.Open(varNewWb)
End If

Application.ScreenUpdating = False

For Each wksSource In wbkOld.Worksheets
strSheetName = wksSource.Name
On Error Resume Next
' Check same sheet exists in new workbook
Set wksTarget = wbkNew.Worksheets(strSheetName)
If Not wksTarget Is Nothing Then
lngCommentColumn = wksSource.Range("IV1").End(xlToLeft).Column

'// If Row 1 is always a header, maybe start checking at Row 2
'Set rngSourceData = wksSource.Columns(lngCommentColumn) _
.SpecialCells(xlCellTypeConstants)
Set rngSourceData = _
wksSource.Range(wksSource.Cells(2, lngCommentColumn), _
wksSource.Cells(Rows.Count, lngCommentColumn)) _
.SpecialCells(xlCellTypeConstants)

'// Only if Col 5 (E) can be counted on to be unique identifier for the //
'// record... Set references to these in both the new and old wb's //
Set rngAETermNew = _
wksTarget.Range("E2:E" & wksTarget.Cells(Rows.Count, "E").End(xlUp).Row)
Set rngAETermOld = _
wksSource.Range("E2:E" & wksSource.Cells(Rows.Count, "E").End(xlUp).Row)

'// for each ID in the new wb... //
For Each rngCell In rngAETermNew
'// see if we find the same AETerm in the old wb.//
Set rngFindMatch = rngAETermOld.Find(What:=rngCell.Value, _
After:=rngAETermOld(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
'// rngFindMatch will return Nothing if not found in the old wb, so we //
'// know its a new record. //
If rngFindMatch Is Nothing Then
rngCell.Offset(, -4).Resize(, 5).Interior.ColorIndex = 6
End If
Next

For Each rngCell In rngSourceData
Set rngFinder = wksTarget.Columns(1).Find( _
What:=wksSource.Cells(rngCell.Row, 1), LookAt:=xlWhole)
If Not rngFinder Is Nothing Then
strFirstAddress = rngFinder.Address
Do
blnMismatch = False
For lngCounter = 1 To lngCommentColumn - 2
If rngFinder.Offset(0, lngCounter) <> _
wksSource.Cells(rngCell.Row, 1).Offset(0, lngCounter) Then

blnMismatch = True
Exit For
End If
Next lngCounter
If Not blnMismatch Then
wksTarget.Cells(rngFinder.Row, lngCommentColumn) = rngCell
Else
Set rngFinder = wksTarget.Columns(1).FindNext(rngFinder)
End If
Loop While blnMismatch = True _
And rngFinder.Address <> strFirstAddress _
And Not rngFinder Is Nothing
End If
Next rngCell
End If
Next wksSource
wbkNew.Save
wbkNew.Close
wbkOld.Close False
Application.ScreenUpdating = True
Set wksSource = Nothing
Set wksTarget = Nothing
Set wbkNew = Nothing
Set wbkOld = Nothing
End Sub
[/vba]

Hope this helps,

Mark

[colm.smyth]

also the code runs accross many worksheets, it must be generic, it cant specif column names

Hi Mark,

O hope i have not confused you in my OP, but the code i supplied already works and pull accross the comments for identical rows, but i just want to now have the code highlight what the changed cells are on the rows that no comment came accross for, do you know what i mean ?

[GTO]

#6

O hope i have not confused you in my OP, but the code i supplied already works and pull accross the comments for identical rows, but i just want to now have the code highlight what the changed cells are on the rows that no comment came accross for, do you know what i mean ?

Dear Colm,

Not a worry as to confusing me, it is a state that I am used to :-)

If you are referring to the alterations I made as to starting below the header row as to the "...aready works..." part, that is fine, simply ditch the suggestions. If that was in reference to the line continuations I tossed in, those are simply for those of us who may be viewing the post on a smaller/laptop screen. It is simply, a pain in the a** to try and read stuff when you have to scroll back and forth...

As to highlighting changed cells (I presume in pre-existing records), I did state that I hadn't dealt with this yet, as I think we need to see how we are identlifying what is a new record - which brings us to...

#7

also the code runs accross many worksheets, it must be generic, it cant specif column names

Okay... unless I am really off tonight (very possible), I think we need to know how we are identifying a record as new. It wouldn't have to be on a hard coded column, but as my logic works, we utterly must have some way of saying that this one 'thing' can be used to determine the record (row) to be new or not. Does that make sense?

In closing, did you try the code? I tested several times, and whilst the code is certainly not 'prettied up', it appeared to highlight the new record.

Mark

[colm.smyth]

Hi Mark,

Thanks for the help you are giving, I have a bit more time this post to describe the process that created these files.

I created the reports using software called SAS, so these are listings, the columns never change from one run to another.

The far right column on the report is called "Comments", the review put their comments into this column. Problem is next time the get the report the comment are gone, so the new report contains everything previously plus new data plus updated data.

This macro simply matches up the identical cells in both old and new between column A and the column before "Comments", if they are identical it then pulls the comment in columns "Comments" over to the new file.

Users then filter on the "Comments" column where its blank, the blanks are brand new or changed data. I would like to highlight what is brand new in green and whats the same row but just has maybe a cell different in yellow.

its very important that the script is generic to run over any listing as they will have many different column headings in my company

I hope this provides useful insight

Thanks

Colm

#6


Dear Colm,

Not a worry as to confusing me, it is a state that I am used to :-)

If you are referring to the alterations I made as to starting below the header row as to the "...aready works..." part, that is fine, simply ditch the suggestions. If that was in reference to the line continuations I tossed in, those are simply for those of us who may be viewing the post on a smaller/laptop screen. It is simply, a pain in the a** to try and read stuff when you have to scroll back and forth...

As to highlighting changed cells (I presume in pre-existing records), I did state that I hadn't dealt with this yet, as I think we need to see how we are identlifying what is a new record - which brings us to...

#7


Okay... unless I am really off tonight (very possible), I think we need to know how we are identifying a record as new. It wouldn't have to be on a hard coded column, but as my logic works, we utterly must have some way of saying that this one 'thing' can be used to determine the record (row) to be new or not. Does that make sense?

In closing, did you try the code? I tested several times, and whilst the code is certainly not 'prettied up', it appeared to highlight the new record.

Mark