VBA Loop for Multiple Sheet to Search Wildcard on Master

[Lewisleh]

I am VERY new to vba and usually use record macro for repetitive functions but can't do so in this case so need some help with coding. My question was deleted from another question site so I'm going to try to do a better job explaining, as I would really love the coding to make this work. I have multiple sheets that are named differently but all start with "ZZZ" (I will refer to as ZZZ sheets going forward). Each ZZZ sheet has Name1 in cell C2, Name2 in D2 and Name3 in E2. I need to search Name1, Name2 and Name3 on another sheet named Master and return data from the Master sheet. The Master sheet has Data-FullName-Address in column A and a Date in column B.

ZZZ_1234 sheet

ColumnA	ColumnB	ColumnC	ColumnD	ColumnE
		Name1	Name2	Name3
		Jon	Edward	Smith

<tbody>
</tbody>

Master sheet

ColumnA	ColumnB
39208James D Wilson 549 Blue St, Asheville NC	10/12/17
TR67Jonathon Graham 2390 Sixth St, Lynchburg VA	12/18/17
87WFG98Edward James 6471 Jonas Lane, Nashville TN	2/17/18
639UR2Jon R Smith 148 Main St, Chapel Hill, NC	9/25/17

<tbody>
</tbody>

So for each ZZZ sheet, I want to search each name (Jon, Edward, Smith for this example) on the Master sheet in column A and if the name is found then copy data in A & B and paste it back to the ZZZ sheet starting in A4. There may be more than one match for each name. I would also like the results to bold the matched name, even if the match is part of the address (as shown in example). So for this example, sheet ZZZ_1234 would look like:

End Result for ZZZ_1234

	Column A	Column B	Column C	Column D	Column E
1
2			Jon	Edward	Smith
3
4	TR67Jonathon Graham 2390 Sixth St, Lynchburg VA	12/18/17
5	87WFG98Edward James 6471 Jonas Lane, Nashville TN	2/17/18
6	639UR2Jon R Smith 148 Main St, Chapel Hill, NC	9/25/17

<tbody>
</tbody>

If none of the names on the ZZZ sheet are found on the Master then show "No Matches Found" on the ZZZ sheet in A4. Then loop to go to the next sheet name starting with ZZZ and
repeat the search for Name1, Name2 and Name3 on the Master sheet.

Thanks for any help!!

 

[JLGWhiz]

try this

Sub t()
Dim sh As Worksheet, ws As Worksheet, c As Range
Set sh = Sheets("Master")
    For Each ws In ThisWorkbook.Sheets
        If ws.Name Like "ZZZ*" Then
            For i = 3 To 5
                For Each c In sh.Range("A2", sh.Cells(Rows.Count, 1).End(xlUp))
                    If InStr(c.Value, ws.Cells(2, i).Value) > 0 Then
                        If ws.Range("A4") = "" Then
                            ws.Range("A4") = c.Value
                            ws.Range("B4") = c.Offset(, 1).Value
                        Else
                            ws.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
                            ws.Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = c.Offset(, 1).Value
                        End If
                    End If
                    ws.Range("A:B").EntireColumn.AutoFit
                Next
            Next
        End If
    Next
End Sub

 

[Lewisleh]

WOW - Awesome!! It is looping perfectly and giving results but there is one small issue. When none of the names are found on the Master sheet, it is returning the entire data list from the Master sheet instead of putting "No Matched Found" in A4 of the ZZZ sheet.

 

[JLGWhiz]

This criteria has to be met before it can return anything to the destination sheet.

 If InStr(c.Value, ws.Cells(2, i).Value) > 0 Then

This line of code checks each data string in each cell of column A on the master in turn to determine if there is a match anywhere in that string for for each of the three strings in C2:E2 of the destination sheet. If it is returning data, then it found a match somewhere in the data string of column A on the Master sheet. The InStr function does not necessarily look at whole words. It will also return matches on partial words, i.e. Jon can be found in Jones, Jonathan, Jonas, etc. It also does not have to be the beginning of the word to match. Not having a view of your actual data, it is difficult to determine what the real problem might be.

 

[Lewisleh]

Thank you for responding - I have looked back and I think the issue occurs when I have a blank cell. When a name has a title or an initial, I have code to eliminate those so they aren't searched in the Master. So the name Jackie P Davis MD, the P and MD are removed from the search columns leaving Jackie in column C and Davis in column E. I'm thinking the blank cell in column D is causing the macro the issue, perhaps? Below is some of the data returned for Jackie Davis.

A	B	C	D	E
Jackie P Davis MD		Jackie		Davis
TR349E William & Ellen Travis 298 Main St, Oakland CA	8/15/2016
93U Stacie Merritt 40893 University Dr, Richmond, VA	7/29/2014
CFRE390U Rufus & Karen Riley Sr 829 Hilltop Circle, Asheville, NC	8/15/2017
XCD90 Lorena Childress 641 Snatchburg Ln, Milton, TN	10/6/2016
WR456E Leamon & Nancy Pickard 690 Treyburn Dr, Charlotte, NC	7/5/2014
E456T Young Sun 775 Hightower Dr, Sandy Springs, GA	1/26/2015
VGR9 Joshua & Denise Jones 309 Greentree Dr, Burlington, TX	10/23/2017
43FV7 Melinda Sue Foushee 1009 Second St, Lynchburg, VA	1/2/2018
RG89Q2 Stuart S Connock PHD 8790 Holt Dr Greenville, SC	12/9/2017
9JH0456 Donna Allen Crary 1048 Forest Rd, Durham, Ohio	9/2/2017
I9O87 Jeff M Beliveau JR 276 Barefoot Landing Ln, Myrtle Beach SC	5/29/2017
34RF7 Diego R Lockman 45 Club Way, Summer, WV	8/1/2016
NC67 Gerard A Cohen Pierre 113 Caraline Ln, Duck, FL	10/22/2016
Gary Daigneau Sweeney Sr 378 Baker St, Washington, OR	9/13/2017
HPT876O Robert S Munoz 647 Horseshoe Lane, Austin TX	10/28/2017
SFC4231 Daniel Payer Hartnett Sr 7 Big Dipper Dr, Timberlake, GA	4/5/2017

<tbody>
</tbody><colgroup><col><col><col span="3"></colgroup>

 

[JLGWhiz]

A blank cell in C2:E2 would definitely return every record in column A. Here is a modified version that should eliminate that problem.

Sub t2()
Dim sh As Worksheet, ws As Worksheet, c As Range
Set sh = Sheets("Master")
    For Each ws In ThisWorkbook.Sheets
        If ws.Name Like "ZZZ*" Then
            For i = 3 To 5
                For Each c In sh.Range("A2", sh.Cells(Rows.Count, 1).End(xlUp))
                    If ws.Cells(2, i).Value <> "" Then
                        If InStr(c.Value, ws.Cells(2, i).Value) > 0 Then
                            If ws.Range("A4") = "" Then
                                ws.Range("A4") = c.Value
                                ws.Range("B4") = c.Offset(, 1).Value
                            Else
                                ws.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
                                ws.Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = c.Offset(, 1).Value
                            End If
                        End If
                    End If
                    ws.Range("A:B").EntireColumn.AutoFit
                Next
            Next
        End If
    Next
End Sub

 

[Lewisleh]

Sorry to shout but THIS IS AWESOME!!!!! It works perfectly!! Thank you, thank you!! I value your time in reading this post and writing the code!

 

[JLGWhiz]

Sorry to shout but THIS IS AWESOME!!!!! It works perfectly!! Thank you, thank you!! I value your time in reading this post and writing the code!

You're welcome,
regards, JLG