Hi again,
Am Mon, 5 Aug 2013 13:26:56 -0700 (PDT) schrieb (e-mail address removed):
Sorry didn't complete it, Col D is <blank> and ColE >0, in COL H will be "Dropbox"
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", "Skydrive")
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"
If Len(c) = 21 And IsNumeric(Right(c, 5)) Then
myStr = "Job Not Done"
ElseIf Len(c) = 22 And IsNumeric(Right(c, 6)) Then
myStr = "Notes Lodged"
End If
Case "BOD"
myStr = IIf(IsNumeric(Mid(c, 5, 6)) And _
IsNumeric(Mid(c, 12, 8)), "Job Pending", "Call Back")
Case "Skydrive"
myStr = IIf(Len(c) >= 12 And Len(c) <= 14 And _
IsNumeric(Trim(Replace(c, "Skydrive", ""))), "DropBox", "")
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.