List column numbers if columns contain string - vba

Question

I have some code that searches for the string "dog" in sheet1 of a workbook, the string can appear many times in the sheet, and it gives me a vector of the column numbers if the string was found in those columns, (dog can only appear once in each column). I have a button on the sheet which I assign this macro:
Option Explicit
Sub mymacro2()
Dim dog() As Integer
Dim coldog As Range
Set coldog = Sheets(1).UsedRange.Find("dog", , xlValues, xlWhole)
Dim i As Integer
i = 0
ReDim dog(0)
dog(i) = coldog.Column
Do
i = i + 1
ReDim Preserve dog(i)
Set coldog = Sheets(1).UsedRange.FindNext(coldog)
dog(i) = coldog.Column
Loop While dog(i) <> dog(0)
ReDim Preserve dog(i - 1)
Sheets(1).Cells(1, 1).Resize(1, UBound(Application.Transpose(dog))) = dog
'above line is displaying the vector on the sheet for testing purposes
Set coldog = Nothing
ReDim dog(0)
End Sub
The macro gives me the vector I want, i.e. it tells me in which columns I can find the string "dog".
Now, I want to modify the code or create a whole new code that does the same thing for each string in a list of strings found in column 1 on sheet2. All the vectors with the column numbers has to have the same name as the string it has column information about. Like I do manually in the code above.
The point is I have a list of about 130 animals which I need to do the same thing for. What is the best way of doing that in Excel VBA?

Answer 1

You have to store all the animals in another Array and call the given actions for each of them. Also your code has quite a few redundant parts. The sample code below should give you a good grasp to understand how to face this problem (as said via comment by Mehow, we are not here to write codes for you).
Dim totAnimals As Integer, i As Integer
totAnimals = 3
ReDim animals(totAnimals - 1) As String
animals(0) = "dog"
animals(1) = "cat"
animals(2) = "mouse"
'etc.
maxMatches = 100 'Maximum number of matches per animal. better don't make this value too big
ReDim matchCount(totAnimals - 1) 'This counter goes from 1 to maxMatches
ReDim matchCols(totAnimals - 1, maxMatches) As Integer
Dim targetRange As Range, tempRange As Range, tempRange2 As Range
Set targetRange = Sheets("sheet2").Columns(1)
For i = 0 To totAnimals - 1
Set tempRange = targetRange.Find(animals(i), , xlValues, xlWhole)
If (Not tempRange Is Nothing) Then
If (matchCount(i) + 1 <= maxMatches) Then
matchCount(i) = matchCount(i) + 1
matchCols(i, matchCount(i)) = tempRange.Column
Dim startAddress As String: startAddress = tempRange.Address
Set tempRange2 = tempRange
Do
Set tempRange2 = targetRange.FindNext(tempRange2)
If (Not tempRange2 Is Nothing) Then
If (tempRange2.Address = startAddress) Then Exit Do
Else
Exit Do
End If
If (matchCount(i) + 1 > maxMatches) Then Exit Do
matchCount(i) = matchCount(i) + 1
matchCols(i, matchCount(i)) = tempRange2.Column
Loop While (Not tempRange2 Is Nothing)
End If
End If
Next i