Search for multiple duplicates and return value in new list

Peaceless

New Member
Joined
Sep 6, 2013
Messages
29
Hi all!

I have tried to solve my issue with formulas like Index and Match but have not been able to do this in any efficient way unfortunately so I am turning to you to seek help. I guess I need to solve this with a macro.

I have two workbooks, one which I work in (wb1) and one with all the data (wb2). In wb1 I have a list of values, I would like to search wb 2 for matches in a specific column in predetermined sheets in that workbook. When a match is found, I want a different cell in that row to be copied in to a specified cell in wb 1. There might be several matches in wb 2 in different sheets as well. Every value in the list in wb 1 will have at least one match in wb 2. There might be values in the list in wb 1 that matches within the list as well and ideally I´d only want one output as they later on will be sent out in an e-mail.

Any suggestions on how I would go about to solve this?

Thankfull for any help!

kr,

Åsa
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Hi all!

I have tried to solve my issue with formulas like Index and Match but have not been able to do this in any efficient way unfortunately so I am turning to you to seek help. I guess I need to solve this with a macro.

I have two workbooks, one which I work in (wb1) and one with all the data (wb2). In wb1 I have a list of values, I would like to search wb 2 for matches in a specific column in predetermined sheets in that workbook. When a match is found, I want a different cell in that row to be copied in to a specified cell in wb 1. There might be several matches in wb 2 in different sheets as well. Every value in the list in wb 1 will have at least one match in wb 2. There might be values in the list in wb 1 that matches within the list as well and ideally I´d only want one output as they later on will be sent out in an e-mail.

Any suggestions on how I would go about to solve this?

Thankfull for any help!

kr,

Åsa

and what to do with the multiple matches?
 
Upvote 0
and what to do with the multiple matches?

When a match is found, I want a different cell in that row to be copied in to a specified cell in wb 1; So match found, look in that row and copy a cell in a different colulmn, paste that value in a specified cell in workbook 1. If mulitiple matches copy and past them all in below one another

Hope that is more clear?

thanks!
 
Upvote 0
here an sample to use the find next method

Code:
Sub peaceless()
Dim wb1 As Workbook, wb2 As Workbook
Dim myrange As Range
Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
With wb1.Sheets("Sheet1")
Set myrange = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row) 'set Range of wb1 in Sheets1 Column A
End With

Workbooks.Open Filename:=ThisWorkbook.Path & "\Copy of Book1.xlsx" 'open 2nd WB same path as WB1
Set wb2 = ActiveWorkbook

For Each cell In myrange 'loop each cell in wb1 myrange
 With wb2
  For Each ws In Worksheets ' loop each sheet in wb2
   With ws.Cells
    Set c = .Find(cell.Value, LookIn:=xlValues) 'find the values of wb1 in wb2 using the findnext method
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            MsgBox "Match found for value " & cell.Value & " on Sheet " & ws.Name & " with value of " & .Cells(c.Row, c.Column + 1) & "."
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress And cell.Value <> ""
     End If
   End With
  Next ws
 End With
Next cell
wb2.Close False 'close wb2 save no changes
End Sub
 
Upvote 0
here an sample to use the find next method

Code:
Sub peaceless()
Dim wb1 As Workbook, wb2 As Workbook
Dim myrange As Range
Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
With wb1.Sheets("Sheet1")
Set myrange = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row) 'set Range of wb1 in Sheets1 Column A
End With

Workbooks.Open Filename:=ThisWorkbook.Path & "\Copy of Book1.xlsx" 'open 2nd WB same path as WB1
Set wb2 = ActiveWorkbook

For Each cell In myrange 'loop each cell in wb1 myrange
 With wb2
  For Each ws In Worksheets ' loop each sheet in wb2
   With ws.Cells
    Set c = .Find(cell.Value, LookIn:=xlValues) 'find the values of wb1 in wb2 using the findnext method
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            MsgBox "Match found for value " & cell.Value & " on Sheet " & ws.Name & " with value of " & .Cells(c.Row, c.Column + 1) & "."
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress And cell.Value <> ""
     End If
   End With
  Next ws
 End With
Next cell
wb2.Close False 'close wb2 save no changes
End Sub

Thank you! I´ll see how I can modify it to my liking :D
 
Upvote 0
Thank you! I´ll see how I can modify it to my liking :D

bah, did not get very far :( The workbook (wb 2) is already open. The values in the list is actually vlooked up from there to start with. Should I activate wb2 instead? How would I do that in that case?

thanks again!
 
Upvote 0
without opening the other workbook

Code:
Sub peaceless()
Dim wb1 As Workbook, wb2 As Workbook
Dim myrange As Range
Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
With wb1.Sheets("Sheet1")
Set myrange = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row) 'set Range of wb1 in Sheets1 Column A
End With

Set wb2 = Workbooks("Copy of Book1.xlsx") 'change the workbookname to suit your requirements

For Each cell In myrange 'loop each cell in wb1 myrange
 With wb2
  For Each ws In Worksheets ' loop each sheet in wb2
   With ws.Cells
    Set c = .Find(cell.Value, LookIn:=xlValues) 'find the values of wb1 in wb2 using the findnext method
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            MsgBox "Match found for value " & cell.Value & " on Sheet " & ws.Name & " with value of " & .Cells(c.Row, c.Column + 1) & "."
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress And cell.Value <> ""
     End If
   End With
  Next ws
 End With
Next cell
End Sub
 
Upvote 0
without opening the other workbook

Code:
Sub peaceless()
Dim wb1 As Workbook, wb2 As Workbook
Dim myrange As Range
Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
With wb1.Sheets("Sheet1")
Set myrange = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row) 'set Range of wb1 in Sheets1 Column A
End With

Set wb2 = Workbooks("Copy of Book1.xlsx") 'change the workbookname to suit your requirements

For Each cell In myrange 'loop each cell in wb1 myrange
 With wb2
  For Each ws In Worksheets ' loop each sheet in wb2
   With ws.Cells
    Set c = .Find(cell.Value, LookIn:=xlValues) 'find the values of wb1 in wb2 using the findnext method
     If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            MsgBox "Match found for value " & cell.Value & " on Sheet " & ws.Name & " with value of " & .Cells(c.Row, c.Column + 1) & "."
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress And cell.Value <> ""
     End If
   End With
  Next ws
 End With
Next cell
End Sub

hmm, that didn´t work actually, it searches in the wb1, never switches to wb 2 and then crashes...
 
Upvote 0
its working for me wb1 holds the macro and looks only in wb2 did you changed the name to your requirements of the wb2 set event?
 
Upvote 0
the open file is a Read only by default, would that make any difference?

Edit: I changed the file extension to xlsx instead of xls as the original, and the crashing stopped but still looking in wb 1 though. And I cannot change the file extension on the default file..., darn
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,215
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top