COMPARE ENTRIES IN ONE WORKBOOK AGAINST ANOTHER

[dgr]

Hello good people

I need a VB macro for the following purpose.

The scenario:-
I have a workbook(book1.xls) with 10 sheets(Sheet1, Sheet2, Sheet3, etc). All sheets contain data(text) in column A. I have another workbook(book2.xls) with 1 sheet(Sheet1). This book also contains data(text) in column A.

What I want to achieve:-
1. If the data in cell A1 from book2.xls is found anywhere in book1.xls, then cut cell A1 from book2.xls and paste in next to the found cell in book1.xls.
2. Repeat process for cell A2, A3, etc until there are no more data in book2.xls or there are no more matches.

Example:-
1. The data in cell A6530 of book2.xls is also found in Sheet9 cell A8665 of book1.xls.
2. Cell A6530 of book2.xls is cut & pasted in Sheet9 cell B8665 of book1.xls.

I've seen some good examples on this site but I don't know how to edit them to suit my specific purpose.

Thanks a lot for contributing your knowledge.

ROBERT RAM

 

[XLGibbs]

This can be done a number of ways in code.

Are the number of rows always changing in book2.xls?

Are the number rows in each of the 10 sheets in book1.xls changing as well?

Is the text formatted the same or could there be differences in Capitalization etc?

Are there only to be exact matches or do partial matches count?

Do you want the cell CUT or COPIED from book2?

Do want the non-matching rows in any sheet of Book1.xls to be hidden if there is no match?

Do you want to count how many matches are found? per sheet? total?

I can bang something out that would do the trick, but don't want it to be useless...

 

[XLGibbs]

Hey, this is a really quick, likely able to be made cleaner, but works fast and efficiently to do the requested task. It cycles through the names in the sheet on Book2 (After temporarily copying to Book1) and for each name cycles through EVERY worksheet in Book1 (that is not the source list of names) and compares the last name. Dependent on a SPACE occuring before the last name, and only 1 space occurring in each First Name = Last Name sequence. Will not work for John Paul Smith, but will work for Dave Yglksjhdfjhkjhkjshdf.

Let me know how you want it tweaked. This has been tested on 5 sheets with 20,000 names in each column A compared to a list of 5000 last names and was really fast.

I would like to see how the MVPs would tackle this as I am sure they can do it with a lot less code and loops, I enjoyed banging it out though, always good to learn some new tricks. I did run into some trouble when trying to go between workbooks which is why I copied the source list into book1...

Anyways...hope it helps

Pete

Sub CopyNames()

Dim SearchWks As Worksheet
Dim SourceName As String
Dim x as Integer, Z as Integer

'Dependent on workbook names being Book1 and Book2 with Sheetname of Book2 being Sheet1
'Copy Source Worksheet into this book temporarily

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Windows("book2").Activate
Sheets("Sheet1").Copy Before:=Workbooks("Book1").Sheets(1)
ActiveSheet.Name = "SourceA"
ActiveSheet.Visible = False


Set SearchWks = Sheets("SourceA")
   With SearchWks
        For Z = 1 To SearchWks.Cells(65536, 1).End(xlUp).row
            SourceName = SearchWks.Cells(Z, 1)
               Sheets("SourceA").Visible = False
                For Each Ws In Worksheets
                  If Ws.Visible = True Then
                  Ws.Activate
                  With Ws
                      On Error Resume Next
                      For x = 1 To Cells(65536, 1).End(xlUp).row - 1
                         Cells(x, 1).Activate
                         If ActiveCell.Text = "" Then Exit For
                          Nstr = Mid(ActiveCell, WorksheetFunction.Find(" ", ActiveCell), 40)
                          Nstr = Trim(Nstr)
                        If Nstr = SourceName Then
                        ActiveCell.Offset(0, 1) = SourceName
                         End If
                      Next x
                  End With
                End If
            Next Ws
        Next Z
      End With

Sheets("SourceA").Delete
Sheets("Sheet1").Cells(1, 1).Activate

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

MsgBox "Name Comparison Complete"

End Sub

 

[XLGibbs]

A more efficient method....with autofilter for non blanks at end. Adds the source name from Book 2 to column B of Book 1 per sheet where a partial match is found, and avoids the issue of multiple spaces in names, but does not avoid potential partial matches that are not completely accurate. (Stone would match to Galstone)

Sub CopyNames2()

Dim SearchWks As Worksheet
Dim SourceName As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'Copies the book 2 sheet into Book 1, seems faster this way

Windows("book2.xls").Activate
Sheets("Sheet1").Copy Before:=Workbooks("Book1.xls").Sheets(1)
ActiveSheet.Name = "SourceA"
ActiveSheet.Visible = False

Set SearchWks = Sheets("SourceA")
   With SearchWks
        For Z = 1 To SearchWks.Cells(65536, 1).End(xlUp).row  'source list
           SourceName = SearchWks.Cells(Z, 1)
             Sheets("SourceA").Visible = False
               For Each Ws In Worksheets
                  If Ws.Visible = True Then
                  Ws.Activate
                  End If
                   With ActiveSheet.Columns(1)
                     Set Cell = .Find(SourceName, LookAt:=xlPart)
                        If Not Cell Is Nothing Then
                        Cell.Offset(0, 1) = SourceName
                        End If
                   End With
          Next Ws
        Next Z
   End With

Sheets("SourceA").Delete
'MsgBox "Copied"

For Each Ws In Worksheets
 Ws.Select
  Cells.AutoFilter Field:=2, Criteria1:="<>"
 ' MsgBox Ws.Name & " Filtered"
Next Ws

Sheets("Sheet1").Activate

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Always open for suggestions on how to make this better, for my sake and the posters. With as many as 65K rows in each sheet to sort, wondering if there is a faster way.

 

[barbarr]

Cross Post

Cross post at OzGrid http://www.ozgrid.com/forum/showthread.php?t=42051