Hi

Try something like this.

Code:
Sub kTest()
    
    Dim i As Long, j As Long, r As Range, ff As String
    Dim SearchKeys1, SearchKeys2, SearchKeysAll, Replacement
    
    SearchKeys1 = Array("Open", "Received")
    SearchKeys2 = Array("Approved", "Disassemble")
    
    SearchKeysAll = Array(SearchKeys1, SearchKeys2)
    
    Replacement = Array("Gate 1", "Gate 2")
    
    With Intersect(ActiveSheet.UsedRange, Columns(5))
        For i = LBound(Replacement) To UBound(Replacement)
            For j = LBound(SearchKeysAll(i)) To UBound(SearchKeysAll(i))
                Set r = .Find(SearchKeysAll(i)(j), lookat:=2)
                If Not r Is Nothing Then
                    ff = r.Address
                    Do
                        Set r = .FindNext(r)
                        r.Offset(, 4) = Replacement(i)
                    Loop Until r.Address = ff
                End If
            Next
        Next
    End With
    
End Sub