Help merging workbooks

[Cris]

Hi! I have two workbooks, not created in the same place and not shared. I'd
like to be able to merge the two documents so that all similar entries are
flagged/highlighted in some way. Please help!

 

[Joel]

You need to write a VBA macro. There is too little information provided to
be able to give you any code. Give more details. Column, worksheets names ,
workbooks names.

 

[Cris]

Hi there -

The column that the macro should "search" by and flag is Account Number.
The "master" workbook would be called Eknow, and there are three worksheets
called 535, 536, 537 respectively. One search and merge workbook is called
CVM 5 and has a tab for 535, 536, 537. There are other search and merge
workbooks called CVM 1 and Eradicates, each with individual tabs for 535,
536, and 537.

Does this make sense? I appreciate your help!

 

[Joel]

Try this code. It highlights each row that is added in green. You have to
modify the code by changing MyPath. Also you need to change the AcntNumCol
to be the correct column in your worksheet. I assumed there was a header row
in each worksheet so the code skips row 1.


Sub mergeaccounts()

Const MyPath = "c:\temp\test\"
Const AcntNumCol = "B"

AcntRange = AcntNumCol & "2:" & AcntNumCol

MergeBooks = Array("CVM 1.xls", "CVM 5.xls", _
"Eradicates.xls")
ShNames = Array("535", "536", "537")

For Each wkb In MergeBooks
Workbooks.Open Filename:=MyPath & wkb

For Each wksname In ShNames
With ThisWorkbook.Sheets(wksname)
LastRowEKnow = .Cells(Rows.Count, AcntNumCol). _
End(xlUp).Row
Set EknowRange = .Range(AcntRange & LastRowEKnow)
End With

With ActiveWorkbook.Sheets(wksname)
LastRowwkb = _
.Cells(Rows.Count, AcntNumCol). _
End(xlUp).Row

Set wkbRange = _
.Range(AcntRange & LastRowwkb)

For Each cell In wkbRange
If Not IsEmpty(cell) Then
Set c = EknowRange.Find(what:=cell, _
LookIn:=xlValues)

cell.EntireRow.Copy

With ThisWorkbook.Sheets(wksname)
If Not c Is Nothing Then
'found item add below found item

.Rows(c.Row + 1). _
Insert Shift:=xlDown
.Rows(c.Row + 1). _
Interior.ColorIndex = 10
Else
'not found add to end of list
.Rows(LastRowEKnow + 1). _
Insert Shift:=xlDown
.Rows(LastRowEKnow + 1). _
Interior.ColorIndex = 10
End If

LastRowEKnow = _
LastRowEKnow + 1
Set EknowRange = _
.Range(AcntRange & LastRowEKnow)
End With
End If
Next cell
End With
Next wksname

Workbooks(wkb).Close
Next wkb

End Sub

 

[Cris]

Thanks for your help Joel!

Try this code. It highlights each row that is added in green. You have to
modify the code by changing MyPath. Also you need to change the AcntNumCol
to be the correct column in your worksheet. I assumed there was a header row
in each worksheet so the code skips row 1.


Sub mergeaccounts()

Const MyPath = "c:\temp\test\"
Const AcntNumCol = "B"

AcntRange = AcntNumCol & "2:" & AcntNumCol

MergeBooks = Array("CVM 1.xls", "CVM 5.xls", _
"Eradicates.xls")
ShNames = Array("535", "536", "537")

For Each wkb In MergeBooks
Workbooks.Open Filename:=MyPath & wkb

For Each wksname In ShNames
With ThisWorkbook.Sheets(wksname)
LastRowEKnow = .Cells(Rows.Count, AcntNumCol). _
End(xlUp).Row
Set EknowRange = .Range(AcntRange & LastRowEKnow)
End With

With ActiveWorkbook.Sheets(wksname)
LastRowwkb = _
.Cells(Rows.Count, AcntNumCol). _
End(xlUp).Row

Set wkbRange = _
.Range(AcntRange & LastRowwkb)

For Each cell In wkbRange
If Not IsEmpty(cell) Then
Set c = EknowRange.Find(what:=cell, _
LookIn:=xlValues)

cell.EntireRow.Copy

With ThisWorkbook.Sheets(wksname)
If Not c Is Nothing Then
'found item add below found item

.Rows(c.Row + 1). _
Insert Shift:=xlDown
.Rows(c.Row + 1). _
Interior.ColorIndex = 10
Else
'not found add to end of list
.Rows(LastRowEKnow + 1). _
Insert Shift:=xlDown
.Rows(LastRowEKnow + 1). _
Interior.ColorIndex = 10
End If

LastRowEKnow = _
LastRowEKnow + 1
Set EknowRange = _
.Range(AcntRange & LastRowEKnow)
End With
End If
Next cell
End With
Next wksname

Workbooks(wkb).Close
Next wkb

End Sub