Thread: For Each Cell.Value within a 1D array, find each instance within a 2D array.

Goal:
To loop through a 1D array of cell values in one worksheet
& for each value within the loop, perform a "find" function that loops through a 2D array in another sheet.
For Each Cell value that is "found", feed the cell address of each instance inside one cell that is offset(0,2) of the cell, on which the search was performed.


Example.
Cell "A2" in my worksheet("Glossary") contains the value "And". Perform a search of "And" in the worksheet("Wordlist") 2D Array, you will see 8 instances of cells that contain the word "And". Feed the 8 cell address values into an array, then print all the array values into a single cell: worksheet("Glossary").Range("C2").
Then continue on with each cell value in the 1D array.

The "Glossary" Array and the "Wordlist" Array need to be autosized because new values are added to both arrays by different people.

FYI: I uploaded an example file of what I am attempting....

Thanks,
Wayne

Like this?

Sub x()
  
Dim rFind As Range, sAddr As String, r As Range, s As String

For Each r In Sheets("Glossary").Range("A2", Sheets("Glossary").Range("A2").End(xlDown))
    With Sheets("Wordlist").Range("A1").CurrentRegion
        Set rFind = .Find(What:=r, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
        If Not rFind Is Nothing Then
            sAddr = rFind.Address
            s = ""
            Do
                s = s & ", " & rFind.Address(0, 0)
                Set rFind = .FindNext(rFind)
             Loop While rFind.Address <> sAddr
        End If
    End With
    r.Offset(, 2) = Mid(s, 3)
Next r

End Sub

It works. Thanks Stephen!
Wayne

One more issue within the code to correct...

The following line doesnt perform the "find" with every cell.value within the 1D array. There are cells that contain no value. So it searches 35 out of 175 rows.
For Each r In Sheets("Glossary").Range("A2", Sheets("Glossary").Range("A2").End(xlDown))

I have been playing with the following line of code and trying to get it to work, but it is confusing to me when to use Cells. or Range. and I cant get it to work.
Cells.SpecialCells(xlCellTypeLastCell).Row


Any ideas?
(BTW: i like the Address(0,0). I have been trying to figure that out for a while and the help reference on my system doesnt have that referenced).

We work up from the bottom to find the last filled cell, and add a check that the cell is not empty:

Sub x()
  
Dim rFind As Range, sAddr As String, r As Range, s As String

For Each r In Sheets("Glossary").Range("A2", Sheets("Glossary").Range("A" & Rows.Count).End(xlUp))
    If Not IsEmpty(r) Then
        With Sheets("Wordlist").Range("A1").CurrentRegion
            Set rFind = .Find(What:=r, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
            If Not rFind Is Nothing Then
                sAddr = rFind.Address
                s = ""
                Do
                    s = s & ", " & rFind.Address(0, 0)
                    Set rFind = .FindNext(rFind)
                 Loop While rFind.Address <> sAddr
            End If
        End With
        r.Offset(, 2) = Mid(s, 3)
    End If
Next r

End Sub

That did it. Once again, Thanks
Wayne