continuous loop using Find in Excel VBA

Question

I have the below code, which I am having trouble with:

Sub getAccNos()

Dim oNameRange As Range
Dim oFindRng As Range

Dim sName As String
Dim sAccNo As Stri         


        

Answer 1

Here is a simple code which doesn't loop through Sheet1 cells to find a match. It uses .FIND and .FINDNEXT. More about it HERE.

Place this code in a module and simply run it. This code is based on your sample file.

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim lRow As Long, i As Long
    Dim sAcNo As String
    Dim aCell As Range, bCell As Range

    '~~> This is the sheet which has account numbers
    Set wsI = ThisWorkbook.Sheets("Sheet1")
    '~~> This is the sheet where we need to populate the account numbers
    Set wsO = ThisWorkbook.Sheets("Sheet2")

    With wsO
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row

        .Range("A1:A" & lRow).NumberFormat = "@"

        For i = 2 To lRow
            Set aCell = wsI.Columns(2).Find(What:=.Range("B" & i).Value, _
                        LookIn:=xlValues, LookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)

            If Not aCell Is Nothing Then
                Set bCell = aCell
                sAcNo = sAcNo & "," & aCell.Offset(, -1).Value

                Do
                    Set aCell = wsI.Columns(2).FindNext(After:=aCell)

                    If Not aCell Is Nothing Then
                        If aCell.Address = bCell.Address Then Exit Do
                        sAcNo = sAcNo & "," & aCell.Offset(, -1).Value
                    Else
                        Exit Do
                    End If
                Loop
            End If

            If sAcNo <> "" Then
                .Range("A" & i).Value = Mid(sAcNo, 2)
                sAcNo = ""
            End If
        Next i
    End With
End Sub

SCREENSHOT

Hope this is what you wanted?