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 String

Set oNameRange = Workbooks("New Name Work.xls").Worksheets("Manual").Range("B4")

Do While Not oNameRange.Text = ""
    sName = Trim(oNameRange.Text)
    Workbooks("New Name Work.xls").Worksheets("sheet1").Select
    Set oFindRng = Cells.Find(What:=sName, After:=activecell)

    Do While Not oFindRng Is Nothing
        oNameRange.Offset(0, -1).Value = oFindRng.Offset(0, 1).Text
        oFindRng.Offset(1, 0).Activate
        Set oFindRng = Cells.Find(What:=sName, After:=activecell)
    Loop
    Set oNameRange = oNameRange.Offset(1, 0)
Loop
End Sub

Basically, on worksheet sheet1 I have a list of names with account number, and there can be several account numbers with the same name. On my target sheet, called Manual, I have the names .... but the account numbers are missing and I would like to get them.

I cannot use VLOOKUP because there are several names that are the same and I need to get a list of all the account numbers. How can I do this?

I tried to write the above code using FIND in VBA, unfortunately, I am missing something elementary as once in the inside Do Loop it just loops continuously when it should be stepping out (as for the first one there is only one occurrance)

thanks for showing me what I am doing wrong, or maybe a formula would be better?

Solution 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?

Solution 2

Here is an example. What I would do is count how many occurrences, and then add another variable to increment for each occurrence, and Loop While Not foundCount >= howManyInRange

Sub FindInRange()

Dim howManyInRange As Long
Dim foundCount As Long
Dim oFindRange As Range
Dim rngSearch As Range
Dim srchVal As String

srchVal = "Steve"
Set rngSearch = Range("D:D")

'## First, check to see if the value exists.'

howManyInRange = Application.WorksheetFunction.CountIf(rngSearch, srchVal)

If Not howManyInRange = 0 Then
    Do
        Set oFindRange = rngSearch.Find(what:=srchVal, After:=ActiveCell)
        '## Avoid duplicate and infinite loop:'
        foundCount = foundCount + 1
        oFindRange.Activate
        '## Do your stuff, here.'

        Debug.Print oFindRange.Address

    Loop While Not foundCount >= howManyInRange
End If

End Sub

Comments

[K_B]

Philip, if your introduction is sarcasm towards the OP would you please be so kind to alter that? If not, please forgive me for misunderstanding

[David Zemens]

@K_B Philip is the OP :)

[Siddharth Rout]

Are you still looking for a solution? If yes then I can post a solution which doesn't use Loops but uses .Find and .FindNext

[Siddharth Rout]

Ok :) Do you have a sample file I can use? Also do you want code that runs from VBA or a User Defined Function (can be called from worksheet)

[Our Man in Bananas]

@SiddharthRout sorry, can't give the file as it's well, people's information, and running it from VBA would be fine.

[Siddharth Rout]

Yes but you can create dummny names and dummy accoutn number .. say just five rows of data?

[Our Man in Bananas]

where would I send the file please?

[Siddharth Rout]

I will not get the message if you do not add "@" like you did previously. :) You may upload it on wikisend.com and share the link here?

[Our Man in Bananas]

@SiddharthRout: here is the link to [download the file with sample data](wikisend.com/download/167004/SO Siddharth Rout Help file.xls)

[Our Man in Bananas]

+1 this is great thanks, in the one I wrote, there is only one account number per record, but I prefer your solution where all the account nos. are show for each name!

[Siddharth Rout]

Yeah I based my code on your comment I cannot use VLOOKUP because there are several names that are the same and I need to get a list of all the account numbers. How can I do this?

[Davesexcel]

I like this, can you have it so we don't require an active cell?