Offset based on Values in Column E

[mrmmickle1]

After using the below code for a few days I have realized that it is not functioning properly in regards to one value: "Pre Test" When this value is found instead of inserting the value: "Gate 1" as I anticipate it inserts "Gate 2". I am unsure of why this is happening. I need it to insert "Gate 1" as later in the code I use this value to Outline the data into groups.

Here is the code and file I am having trouble with:

ub FormatQuantumDataDumpCS()
' Rearranges Data into the correct format and inserts correct titles for Header Row
    Columns("B:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:N").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:AA").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "W/O #"
    Columns("D:D").Select
    Selection.Cut
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("D:D").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Model"
    Columns("E:E").Select
    Selection.Cut
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Date In"
    Columns("G:G").Select
    Selection.Cut
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Date Quoted"
    Columns("H:H").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Date App"
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Ship Date"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Cost Analysis"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Revenue"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Margin"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Credit"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Notes"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Unique"
    Columns("A:A").ColumnWidth = 27    'This is where I change column width and format Column J to Currency
    Columns("M:M").ColumnWidth = 36
    Columns("J:J").ColumnWidth = 20
    Columns("J:J").Select
    Selection.NumberFormat = "$#,##0.00"
    Range("A1").Select
    
End Sub
Sub GroupStatusbyInsertingUniqueValueCS()

'Searches for values in column D and if Found, Inserts New value (Replacement) in Column N
    
    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("Pre Test", "Open", "Received", "Preliminary Ins", "Insp-APU", "Pending", "Inspection", "Clean", "Pre-Test")
    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("Customer Servic")
    SearchKeys4 = Array("Lease")
    SearchKeys5 = Array("Quote on Hold", "Quote")
    SearchKeys6 = Array("Closed", "Invoicing")
    SearchKeys7 = Array("Parking Lot")
    SearchKeys8 = Array("Waiting App.")
    SearchKeys9 = Array("Weld", "Balance Shop", "Cancelled", "Strip Coating", "Waiting Concess", "Machine Shop", "NDT", _
    "Grind Shop", "Paint", "Plating", "Chrome/Cad", "Chrome Strip", "Shot Peen", "Outside Vendor", "Waiting manual", "Quoted for Exch", _
    "Sub-Assembly", "Insp-LH", "Assembly-LH", "PO AN LRU", "Harness-LG", "concession")
    
    
    SearchKeysAll = Array(SearchKeys1, SearchKeys2, SearchKeys3, SearchKeys4, SearchKeys5, _
    SearchKeys6, SearchKeys7, SearchKeys8, SearchKeys9)
    
    Replacement = Array("GATE 1", "GATE 2", "CUSTOMER SERVICE", "LEASE", "QUOTE", "SHIPPED", "SURPLUS PARTS", "WAITING APPROVAL", "OTHER")
    
    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

I run the code in this sequence:

Sub CorrectSequence()

Call FormatQuantumDataDumpCS
Call GroupStatusbyInsertingUniqueValueCS

End Sub

Can any one help me to fix this code were it will use the replacement "Gate 1" when the value "Pre Test" is found? ANy advice or help would be much appreciated.