Consulting

Results 1 to 4 of 4

Thread: Repeat Search Function

  1. #1
    VBAX Regular
    Joined
    Feb 2013
    Posts
    30
    Location

    Repeat Search Function

    Hi,
    I have a long list of incomplete names in "sheet2" which i need to search in "sheet1" which have complete information and paste it into "sheet2". If search doesn't find suitable pair go back to "sheet2" and picks the next value. Repeat this till it finds a blank cell. I have recorded the macro. Can somebody help me in making this code in such a way that it repeats itself until the list is complete.



    Selection.Copy
        Sheets("Sheet1").Select
        Range("A1").Select
        Cells.Find(What:="abc", After:=ActiveCell, LookIn:=xlFormulas2, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
        Range("A2:C2").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Sheet2").Select
        Range("A1").Select
        Cells.FindNext(After:=ActiveCell).Activate
        Range("B2").Select
        ActiveSheet.Paste
        Range("A3").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Sheet1").Select
        Range("A1").Select
        Cells.Find(What:="ijk", After:=ActiveCell, LookIn:=xlFormulas2, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
        Sheets("Sheet2").Select
        Range("A4").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Sheet1").Select
        Range("A1").Select
        Cells.Find(What:="xyz hol", After:=ActiveCell, LookIn:=xlFormulas2, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        Range("A3:C3").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Sheet2").Select
        Range("A1").Select
        Cells.FindNext(After:=ActiveCell).Activate
        Range("B4").Select
        ActiveSheet.Paste
    Range("A4").Select
        Application.CutCopyMode = False
    End Sub

    Thanks
    Attached Files Attached Files
    Last edited by Aussiebear; 11-25-2022 at 12:47 AM. Reason: You also forgot to enclose your code with code tags

  2. #2
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    795
    Location
    Hi Sarfaraz. You can trial this code. Please keep a copy of your wb before testing. HTH. Dave
    Sub test()
    Dim Cnt As Long, Cnt2 As Long, DLen As Integer
    Dim TStr As String, Flag As Boolean, TempStr As String
    'search partial words
    For Cnt2 = 2 To Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
    Flag = False
    TStr = CStr(Sheets("sheet2").Range("A" & Cnt2).Value)
    'loop letters of partial word
    For DLen = 1 To Len(TStr)
    'loop whole words
    TempStr = vbNullString
    For Cnt = 2 To Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
    'compare partial words to whole word
    If LCase(Mid(Sheets("Sheet1").Cells(Cnt, 2), DLen, Len(TStr))) = LCase(TStr) Then
    TempStr = TempStr & LCase(Mid(Sheets("Sheet1").Cells(Cnt, 2), DLen, Len(TStr)))
    'ensure match includes all letters of partial word
    If Left(Sheets("sheet1").Cells(Cnt, 2), Len(TempStr)) = TStr Then
    Sheets("sheet2").Cells(Cnt2, 3) = Sheets("sheet1").Cells(Cnt, 2) 'name
    Sheets("sheet2").Cells(Cnt2, 4) = Sheets("sheet1").Cells(Cnt, 3) 'cust no
    Sheets("sheet2").Cells(Cnt2, 2) = Sheets("sheet1").Cells(Cnt, 1) 'plant no
    Flag = True
    End If
    End If
    Next Cnt
    'if match found move to next partial word
    If Flag Then
    Exit For
    End If
    Next DLen
    Next Cnt2
    End Sub
    Last edited by Dave; 11-25-2022 at 06:55 AM. Reason: code update

  3. #3
    VBAX Regular
    Joined
    Feb 2013
    Posts
    30
    Location
    Great, thanks a lot, it worked perfectly fine.

  4. #4
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    795
    Location
    You are welcome. Thanks for posting your outcome. Dave

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •