Search Multiple different string in excel VBA - string

Question

i am trying to allow the user to search up to 6 different types of strings( text). However i have tried it for up to 2 ,
Problem
but my code only performs the search correctly for the first one. However any of the searches after fisrt string are not achieving the objective.
Objective
The objective of the code is for it to find the string in the speficied row, then search that coloumn for values greater than zero, if so copy the whole row.
Private Sub btnUpdateEntry_Click()
Dim StringToFind As String
Dim SringToFind2 As String
Dim i As Range
Dim cell As Range
StringToFind = Application.InputBox("Enter string to find", "Find string")
StringToFind2 = Application.InputBox("Enter string to find", "Find string")
With Worksheets("Skills Matrix")
Set cell = .Rows(1).Find(What:=StringToFind, LookAt:=xlWhole, _
MatchCase:=False, SearchFormat:=False)
If Not cell Is Nothing Then
For Each i In .Range(cell.Offset(1), .Cells(.Rows.Count, cell.Column).End(xlUp))
If IsNumeric(i.Value) Then
If i.Value > 0 Then
i.EntireRow.Copy
Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
End If
End If
Next i
Else
Worksheets("Data").Activate
MsgBox "String not found"
End If
End With
End Sub
Thank you

Answer 1

Similar solution, designed for flexibility and speed:
Sub tgr()
Dim wb As Workbook
Dim wsSearch As Worksheet
Dim wsData As Worksheet
Dim rFound As Range
Dim rCopy As Range
Dim rTemp As Range
Dim aFindStrings() As String
Dim vFindString As Variant
Dim sTemp As String
Dim sFirst As String
Dim i As Long, j As Long
Dim bExists As Boolean
Set wb = ActiveWorkbook
Set wsSearch = wb.Sheets("Skills Matrix")
Set wsData = wb.Sheets("Data")
ReDim aFindStrings(1 To 65000)
i = 0
Do
sTemp = vbNullString
sTemp = InputBox("Enter string to find", "Find string")
If Len(sTemp) > 0 Then
bExists = False
For j = 1 To i
If aFindStrings(j) = sTemp Then
bExists = True
Exit For
End If
Next j
If Not bExists Then
i = i + 1
aFindStrings(i) = sTemp
End If
Else
'User pressed cancel or left entry blank
Exit Do
End If
Loop
If i = 0 Then Exit Sub 'User pressed cancel or left entry blank on the first prompt
ReDim Preserve aFindStrings(1 To i)
For Each vFindString In aFindStrings
Set rFound = Nothing
Set rFound = wsSearch.Rows(1).Find(vFindString, wsSearch.Cells(1, wsSearch.Columns.Count), xlValues, xlWhole)
If Not rFound Is Nothing Then
sFirst = rFound.Address
Do
For Each rTemp In wsSearch.Range(rFound.Offset(1), wsSearch.Cells(wsSearch.Rows.Count, rFound.Column).End(xlUp)).Cells
If IsNumeric(rTemp) And rTemp.Value > 0 Then
If rCopy Is Nothing Then
Set rCopy = rTemp.EntireRow
Else
Set rCopy = Union(rCopy, rTemp.EntireRow)
End If
End If
Next rTemp
Set rFound = wsSearch.Rows(1).FindNext(rFound)
Loop While rFound.Address <> sFirst
Else
MsgBox "[" & vFindString & "] not found."
End If
Next vFindString
If Not rCopy Is Nothing Then rCopy.Copy wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Offset(1)
End Sub

Answer 2

Instead of storing your string's to search in seperate variables, put them into an array. You can iterate through arrays using a For Each loop so it's a perfect fit:
Private Sub btnUpdateEntry_Click()
Dim StringsToFind(1 to 6) As String
Dim StringToFind as Variant 'Array's demand that their elements be declared as variants or objects, but we know that the element will be a string
Dim i As Range
Dim cell As Range
'Iterate through your empty array and ask for values:
For Each StringToFind in StringsToFind
StringsToFind(StringToFind) = Application.InputBox("Enter string to find", "Find string")
Next StringToFind
With Worksheets("Skills Matrix")
'Now iterate again to search:
For Each StringToFind in StringsToFinds
Set cell = .Rows(1).Find(What:=StringToFind, LookAt:=xlWhole, _
MatchCase:=False, SearchFormat:=False)
If Not cell Is Nothing Then
For Each i In .Range(cell.Offset(1), .Cells(.Rows.Count, cell.Column).End(xlUp))
If IsNumeric(i.Value) Then
If i.Value > 0 Then
i.EntireRow.Copy
Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
End If
End If
Next i
Else
Worksheets("Data").Activate
MsgBox "String not found"
End If
Next StringToFind
End With
End Sub
There's probably some other tweaks inside that second for loop to make so it makes sense when you iterate, but this will get you in the ballpark.