Offset based on Values in Column E

[Admin]

Hi

Try something like this.

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

[mrmmickle1]

Admin,

Thanks so much. I modified it by adding more search keys and got it to work for my needs! I appreciate the help. Here is my Final Product:

Sub GroupStatusbyInsertingUniqueValue()
    
    Dim i As Long, j As Long, r As Range, ff As String
    Dim SearchKeys1, SearchKeys2, SearchKeys3, SearchKeys4, SearhKeys5, SearchKeys6, _
    SearchKeys7, SearchKeys8, SearchKeys9, SearchKeys10, SearchKeysAll, Replacement
    
    SearchKeys1 = Array("Open", "Received", "Preliminary Ins", "Pre Test", "Insp-APU")
    SearchKeys2 = Array("Approved", "Disassemble", "RETURN AS IS", "Waiting Parts", "Waiting Compone", "Assembly", _
    "Test", "Post Test", "QEC", "QC", "QC Discrepancy", "Shipping Prep", "Assembly-APU")
    SearchKeys3 = Array("Clean")
    SearchKeys4 = Array("Inspection")
    SearchKeys5 = Array("Customer Servic")
    SearchKeys6 = Array("Lease")
    SearchKeys7 = Array("Quote on Hold", "Quote")
    SearchKeys8 = Array("Closed", "Invoicing")
    SearchKeys9 = Array("Parking Lot")
    SearchKeys10 = Array("Waiting App.")
    
    
    SearchKeysAll = Array(SearchKeys1, SearchKeys2, SearchKeys3, SearchKeys4, SearchKeys5, _
    SearchKeys6, SearchKeys7, SearchKeys8, SearchKeys9, SearchKeys10)
    
    Replacement = Array("GATE 1", "GATE 2", "GATE 3", "GATE 4", "CUSTOMER SERVICE", "LEASE", "QUOTE", "SHIPPED", "SURPLUS PARTS", "WAITING APPROVAL")
    
    With Intersect(ActiveSheet.UsedRange, Columns(4))
        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(, 10) = Replacement(i)
                    Loop Until r.Address = ff
                End If
            Next
        Next
    End With
    
End Sub