I have this Match Sub which I use but want to alter
Sub FindMatches_Original()
Dim PostBackWS As Worksheet
Dim FindRng As Range, ReplaceRng As Range, fCell As Range, rCell As Range
Dim lRow1 As Long, lRow2 As Long
With ThisWorkbook.Sheets("Sofa")
lRow1 = .Range("A" & .Rows.Count).End(xlUp).Row
Set FindRng = .Range("B2:B" & lRow1)
End With
With ThisWorkbook.Sheets("Helper")
lRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
Set ReplaceRng= .Range("AA2:AA" & lRow2)
End With
Set PostBackWS = ThisWorkbook.Sheets("XXX")
For Each fCell In FindRng
Set rCell = ReplaceRng.Find(fCell.Value, , xlValues, xlWhole, xlByRows, xlNext, MatchCase:=False)
If Not rCell Is Nothing Then
PostBackWS.Range(fCell.Address).Offset(0, 1).Value = rCell.Value
'Set Interior Color for Matches
PostBackWS.Range(fCell.Address).Offset(0, 1).Interior.Color = RGB(255, 255, 0)
Set rCell = Nothing
End If
Next fCell
End Sub
Trying to alter so that
Set FindRng = .Range("AA2:AA" & lRow2)
become a list
aryFind = Array("Bounced", "NotStarted", "Incomplete", "AddedName")
But I am not getting the For loop
For f = 0 To UBound(aryFind)
to work I do not get all the matches I should be getting
Thanks
Sub FindMatchesFromList()
Dim PostBackWS As Worksheet
Dim aryFind As Variant
Dim ReplaceRng As Range, rCell As Range
Dim f As Long, lRow As Long
aryFind = Array("Bounced", "NotStarted", "Incomplete", "AddedName")
With ThisWorkbook.Sheets("Helper")
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set ReplaceRng= .Range("AA2:AA" & lRow2)
End With
Set PostBackWS = ThisWorkbook.Sheets("XXX")
For Each rCell In ReplaceRng
For f = 0 To UBound(aryFind)
Set rCell = ReplaceRng.Find(aryFind(f), , xlValues, xlWhole, xlByRows, xlNext, MatchCase:=False)
If Not rCell Is Nothing Then
PostBackWS.Range(rCell.Address).Offset(0, 1).Value = rCell.Value
'Set Interior Color for Matches
PostBackWS.Range(rCell.Address).Offset(0, 0).Interior.Color = RGB(255, 255, 0)
End If
Next f
Set rCell = Nothing
Next rCell
End Sub
Bookmarks