Hi Blee,
Try this instead.
As you can see there is nothing actually hard coded, its is all done
through the constants.
You can add as many failure codes as you want.
Also, this wont loop through all the cells in the colum.

Kind regards
Bernie Russell

----------------------------------------------------------------------------------
Public Sub Exclusions2()



Const ACTION As String = "Manual"
Const SEARCHPREFIX As String = "Match"
Const REASONPREFIX As String = "Failure Code "
Const OFFSETMANUAL As Integer = -17 'Or whatever offset you want.
Const OFFSETREASON As Integer = -20

Dim FailureCodes() As Variant
FailureCodes = Array("A", "B", "C", "D", "E", "F") 'Put in what ever
you want here

Dim fc As String
Dim sCVal As String

Dim i As Integer
Dim rRangeToSearch As Range
'Set rRangeToSearch = ActiveCell.EntireColumn 'Or set it like this
worksheets(1).Range("A:A")
With ActiveCell.EntireColumn
' This sets the range to be searched to the first cell in the column
to the last used cell in the column.
' So it wont have to go through 65536 cells. ie This is quicker
Set rRangeToSearch =
Range(.Cells(1), .Cells(.Cells.Count).End(xlUp))
Debug.Print rRangeToSearch.Address
End With

On Error GoTo Err_Exclusions2
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Dim c As Range
For Each c In rRangeToSearch.Cells
Debug.Print c.Address & " " & c.Value
With c
If Len(.Value) 0 Then
sCVal = UCase(.Value)
For i = LBound(FailureCodes) To UBound(FailureCodes)
fc = UCase(FailureCodes(i))
If InStr(1, sCVal, UCase(SEARCHPREFIX) & fc) 0 And
Len(fc) < 0 Then
.Offset(0, OFFSETREASON).Value = CStr(REASONPREFIX & fc)
.Offset(0, OFFSETMANUAL).Value = ACTION
End If
Next i
End If
End With 'c
Next c

ExitSub:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
Set c = Nothing
Set rRangeToSearch = Nothing
Exit Sub

Err_Exclusions2:
MsgBox "An error occured in when running the Exclusions2 sub
procedure"
GoTo ExitSub
End Sub