find all string occurances in a column and copy data from adjacent column

Question

I have code which works and finds the first occurance however there could be multiple occurances of the same string. I want to take all these occurances and store them in an array of strings (I understand how to use ReDim to size the array). I have tried looking at some other coding examples but cannot seem to get it to work.

This is my working code for finding the first occurance

' Find the definition from the Excel document
With objWbk.Sheets("Sheet1")
    ' Find the range of the cells with data in Excel doc
    Set rngSearch = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(-4162))

    ' Search in the found range for the
    Set rngFound = rngSearch.Find(What:=strAcronym, After:=.Range("A1"), LookAt:=1)

    ' if nothing is found count the number of acronyms without definitions
    If rngFound Is Nothing Then
        m = m + 1

        ' Set the cell variable in the new table as blank
        targetCellValue(0) = ""

    ' If a definition is found enter it into the cell variable
    Else
        i = 0
        targetCellValue(i) = .Cells(rngFound.Row, 2).Value
    End If
End With

as you can see i have introduced the array and for now just set i to be 0 as I am assuming i will need to implement a loop to find them all.

** It is probably worth noting that all the strings are sorted alphabetically

Answer 1

With this code:

ReDim Tmp(0 To 1000) As String
Dim i, e As Integer
Dim Max As Integer
Dim xx
Dim Str As String

Range("A1").Select
e = 0
Max = 0
Str = "a"
Set xx = Cells.Find(What:=Str, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False)

For i = 1 To 9999
    Cells.FindNext(After:=ActiveCell).Activate
    If (xx Is Nothing) Or (Max > ActiveCell.Row) Then Exit For
    Tmp(e) = ActiveCell.Offset(0, 1).Value
    e = e + 1
    Max = ActiveCell.Row
    Debug.Print e
Next
ReDim Preserve Tmp(e-1)

you found all the occurances. If you want only on a column change two lines:

'    Range("A1").Select
Columns("A:A").Select

'    Cells.FindNext(After:=ActiveCell).Activate
Selection.FindNext(After:=ActiveCell).Activate

Find only on the column / Range selected.

Answer 2

Range has a FindNext and FindPrevious method which you could use, but it doesn't stop at the end - so you have to check for that.

Alternatively, you can iterate directly over the cells,

' Find the definition from the Excel document
With objWbk.Sheets("Sheet1")
    ' Find the range of the cells with data in Excel doc
    'Set rngSearch = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(-4162))
    ' Search in the found range for the
    'Set rngFound = rngSearch.Find(What:=strAcronym, After:=.Range("A1"), LookAt:=1)
    ' if nothing is found count the number of acronyms without definitions    
    for z = 1 to .Rows.Count
        If Not (.Cells("A" &  z, 2).Value like strAcronym) Then
            m = m + 1        
            targetCellValue(0) = "" ' Set the cell variable in the new table as blank
        Else
            i = 0
            targetCellValue(i) = .Cells("A" & z, 2).Value ' If a definition is found enter it into the cell variable
        End If
    next i
End With