Use array and find multiple strings using the belo

Question

How to use array in below code to find multiple strings?

Sub Replace18()
        Dim rng As Range
        Dim rws As Long
        rws = Range("A" & Rows.Count).End(xlUp).Row - 3
        Set rng = Rows("3:3").Find(What:="quantity", LookAt:=xlWhole, MatchCase:=False)
        If Not rng Is Nothing Then
            rng.Offset(1, 0).FormulaR1C1 = "20"
            rng.Offset(1, 0).Resize(rws).FillDown
        End If
End Sub

Answer 1

another variant (based on @Jeeped answer)

Sub test()
    Dim Dic As Object, k As Variant, S$, rws&, x&, Rng As Range
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    S = "Lorem,ipsum,dolor,amet,consectetur,adipiscing,elit,Mauris," & _
        "facilisis,rutrum,faucibus,Sed,euismod,orci,rhoncus,tincidunt,elit,eros"
    For Each k In Split(S, ",")
        If Not Dic.exists(k) Then Dic.Add k, Nothing
    Next k
    rws = Range("A" & Rows.Count).End(xlUp).Row - 3
    x = [3:3].Find("*", , , xlByColumns, , xlPrevious).Column
    For Each Rng In Range([A3], Cells(3, x))
        If Dic.exists(Rng.Value) Then
            Rng.Offset(1, 0).FormulaR1C1 = "20"
            Rng.Offset(1, 0).Resize(rws).FillDown
        End If
    Next Rng
End Sub

or

Sub test2()
    Dim Dic As Object, k As Variant, S$, rws&, x&, Rng As Range
    Set Dic = CreateObject("Scripting.Dictionary"): Dic.CompareMode = vbTextCompare
    S = "Lorem,ipsum,dolor,amet,consectetur,adipiscing,elit,Mauris," & _
        "facilisis,rutrum,faucibus,Sed,euismod,orci,rhoncus,tincidunt,elit,eros"
    For Each k In Split(S, ",")
        If Not Dic.exists(k) Then Dic.Add k, ""
    Next k
    rws = Range("A" & Rows.Count).End(xlUp).Row
    x = [3:3].Find("*", , , xlByColumns, , xlPrevious).Column
    For Each Rng In Range([A3], Cells(3, x))
        If Dic.exists(Rng.Value) Then
            Range(Cells(Rng.Row + 1, Rng.Column), Cells(rws, Rng.Column)).Value = "20"
        End If
    Next Rng
End Sub

Answer 2

Set up a variant array and cycle through them.

Sub Replace18()
    Dim rng As Range, rws As Long, w As Long, vWHATs As Variant

    vWHATs = Array("Lorem", "ipsum", "dolor", "amet", "consectetur", "adipiscing", _
                   "elit", "Mauris", "facilisis", "rutrum", "faucibus", "Sed", _
                   "euismod", "orci", "rhoncus", "tincidunt", "elit", "eros")

    With Worksheets("Sheet2")   '<~~set this worksheet reference properly!
        rws = .Cells.SpecialCells(xlCellTypeLastCell).Row - 3

        For w = LBound(vWHATs) To UBound(vWHATs)
            Set rng = .Rows(3).Find(What:=vWHATs(w), LookAt:=xlWhole, MatchCase:=False)
            If Not rng Is Nothing Then
                'just fill then all at once
                rng.Offset(1, 0).Resize(rws, 1) = "20"
            End If
        Next w
    End With
End Sub

I've modified your search for the 'last row' to include all columns with the Range.SpecialCells method using the xlCellTypeLastCell option. This works best with a properly referenced parent worksheet which I've included in a With ... End With block. All cell and range references within this block should carry a period (aka . or full stop) as a prefix to note that they belong to the worksheet referenced in the With ... End With. This includes .Rows(3) just as the .Find uses a prefix period to note that it is referencing Rows(3).

---