Hi Sean,

Am Mon, 5 Aug 2013 11:55:31 -0700 (PDT) schrieb :

Below is the only part I am having issues with, it shows as <blank in Col H

myStr = IIf(myArr(i) = "GLS" And IsNumeric(Mid(c, 5, 6)) And _
IsNumeric(Mid(c, 12, 8)), "Duty Exceeded", "")

sorry, my bad.

Try:

Sub Test()
Dim c As Range
Dim LRow As Long
Dim i As Integer
Dim myArr As Variant
Dim myStr As String
Dim firstaddress As String

myArr = Array("ABC", "Credit Transfer", "BOD", _
"Opening Sequence", "GLS", "XYZ")
LRow = Cells(Rows.Count, 3).End(xlUp).Row
For i = LBound(myArr) To UBound(myArr)
Set c = Range("C1:C" & LRow).Find(myArr(i), _
LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
firstaddress = c.Address
Do
If Len(c.Offset(, 1) = 0 And c.Offset(, 2)) 0 Then
Select Case myArr(i)
Case "ABC"
myStr = "Job Done"
Case "Credit Transfer"
myStr = IIf(IsNumeric(Right(c, 6)), _
"Job Not Done", "")
Case "BOD"
myStr = IIf(IsNumeric(Mid(c, 5, 6)) And _
IsNumeric(Mid(c, 12, 8)), "Job Pending", "Call Back")
End Select
End If
If Len(c.Offset(, 1) & c.Offset(, 2)) = 0 Then
myStr = IIf(myArr(i) = "Opening Sequence", "Over Risk", "")
End If
If c.Offset(, 1) < 0 And Len(c.Offset(, 2)) = 0 Then
If myArr(i) = "GLS" And IsNumeric(Mid(c, 5, 6)) And _
IsNumeric(Mid(c, 12, 8)) Then
myStr = "Duty Exceeded"
ElseIf myArr(i) = "XYZ" Then
myStr = "Top Level"
End If
End If
c.Offset(, 5) = myStr
myStr = ""
Set c = Range("C1:C" & LRow).FindNext(c)
Loop While Not c Is Nothing And c.Address < firstaddress
End If
Next
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2