how to loop through a wild card search with multiple matches. my code works but only finds 1st match from each sheet

Viewed 16
Sub find_match_engine()
    Dim mykeyword As String
    Dim foundRange As Range
    Dim LastRow As Long, ws As Worksheet
    Dim Row    As Variant
    Dim Name   As String
    mykeyword = ThisWorkbook.Sheets("Search").Range("L2").Value
    ThisWorkbook.Sheets("Search").Range("A3:K365").ClearContents
    Application.ScreenUpdating = False
    Set foundRange = ThisWorkbook.Sheets("Denyo").Range("A3:A60").Find(mykeyword & "*")
    If foundRange Is Nothing Then
        GoTo Line1
        Exit Sub
    Else
        'While foundRange <> ""
        Set ws = ThisWorkbook.Sheets("Search")
        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 
        ws.Range("A" & LastRow).Value = "Denyo"   
        ws.Range("A" & LastRow).Offset(0, 1).Value = foundRange.Value 
        ws.Range("A" & LastRow).Offset(0, 2).Value = foundRange.Offset(0, 1).Value
        ws.Range("A" & LastRow).Offset(0, 3).Value = foundRange.Offset(0, 2).Value
        ws.Range("A" & LastRow).Offset(0, 4).Value = foundRange.Offset(0, 3).Value
        ws.Range("A" & LastRow).Offset(0, 5).Value = foundRange.Offset(0, 4).Value
        ws.Range("A" & LastRow).Offset(0, 6).Value = foundRange.Offset(0, 5).Value
        ws.Range("A" & LastRow).Offset(0, 7).Value = foundRange.Offset(0, 6).Value
        ws.Range("A" & LastRow).Offset(0, 8).Value = foundRange.Offset(0, 7).Value
        ws.Range("A" & LastRow).Offset(0, 9).Value = foundRange.Offset(0, 8).Value
        ws.Range("A" & LastRow).Offset(0, 10).Value = foundRange.Offset(0, 9).Value
        'Wend
    End If
Line1:
    Set foundRange = ThisWorkbook.Sheets("Hitachi").Range("A3:A358").Find(mykeyword & "*")
    If foundRange Is Nothing Then
        GoTo Line2
        'MsgBox "No Engine Model Files Found", vbInformation, "NO FILE HISTORY"
        Exit Sub
    Else
        'While Name <> ""
        Set ws = ThisWorkbook.Sheets("Search")
        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 
        ws.Range("A" & LastRow).Value = "Hitachi" 
        ws.Range("A" & LastRow).Offset(0, 1).Value = foundRange.Value 
        ws.Range("A" & LastRow).Offset(0, 2).Value = foundRange.Offset(0, 1).Value
        ws.Range("A" & LastRow).Offset(0, 3).Value = foundRange.Offset(0, 2).Value
        ws.Range("A" & LastRow).Offset(0, 4).Value = foundRange.Offset(0, 3).Value
        ws.Range("A" & LastRow).Offset(0, 5).Value = foundRange.Offset(0, 4).Value
        ws.Range("A" & LastRow).Offset(0, 6).Value = foundRange.Offset(0, 5).Value
        ws.Range("A" & LastRow).Offset(0, 7).Value = foundRange.Offset(0, 6).Value
        ws.Range("A" & LastRow).Offset(0, 8).Value = foundRange.Offset(0, 7).Value
        ws.Range("A" & LastRow).Offset(0, 9).Value = foundRange.Offset(0, 8).Value
        ws.Range("A" & LastRow).Offset(0, 10).Value = foundRange.Offset(0, 9).Value
        'Wend
    End If
Line2:

0 Answers
Related