I'm looking to obtain code that will do the following:-

Loop through Text/Numeric values in Col C, if it meets certain criteria then place variable text in Col H

The criteria I wish to test against is multiple e.g Test if:-

the fist 3 characters in Col C are the letters ABC + the value in Col D is blank but the value in Col E is 0 then place the text "Job Done" in Col H

Example 2 might be Test if:-

There is the text "Credit Transfer" in Col C + there is also 5 numeric values in Col C (can be any numeric value) + the value in Col D is blank but the value in Col E is 0 then place the text "Job Not Done" in Col H

Example 3 might be Test if:-

There is the text "BOD" in Col C + there is also 6 numeric values & 8 numeric values also in Col C (can be any numeric value) + the value in Col D is blank but the value in Col E is 0 then place the text "Job Pending" in Col H

If I can master above, I can add further scenarios

seanryanie wrote:

I'm looking to obtain code that will do the following:-

Loop through Text/Numeric values in Col C, if it meets certain criteria
then place variable text in Col H

The criteria I wish to test against is multiple e.g Test if:-

the fist 3 characters in Col C are the letters ABC + the value in Col D
is blank but the value in Col E is 0 then place the text "Job Done" in
Col H

Example 2 might be Test if:-

There is the text "Credit Transfer" in Col C + there is also 5 numeric
values in Col C (can be any numeric value) + the value in Col D is blank
but the value in Col E is 0 then place the text "Job Not Done" in Col H

Example 3 might be Test if:-

There is the text "BOD" in Col C + there is also 6 numeric values & 8
numeric values also in Col C (can be any numeric value) + the value in
Col D is blank but the value in Col E is 0 then place the text "Job
Pending" in Col H

If I can master above, I can add further scenarios

You need to clarify what you mean by "5 numeric values in Col C" and "6
numeric values & 8 numeric values also in Col C". Numeric values in the
current row, column C? Numeric values *anywhere* in the column? What?

Here's a start on your code. The 2 places where it says "(True)" are where
clarification is needed:

Sub dwim()
For L0 = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
If ("ABC" = Left$(Cells(L0, 3).Value, 3)) And _
("" = Cells(L0, 4).Value) And (Cells(L0, 5).Value 0) Then
Cells(L0, 8).Value = "Job Done"
ElseIf ("Credit Transfer" = Cells(L0, 3).Value) And (True) And _
("" = Cells(L0, 4).Value) And (Cells(L0, 5).Value 0) Then
Cells(L0, 8).Value = "Job Not Done"
ElseIf (InStr(Cells(L0, 3).Value, "BOD")) And (True) And _
("" = Cells(L0, 4).Value) And (Cells(L0, 5).Value 0) Then
Cells(L0, 8).Value = "Job Pending"
End If
Next
End Sub

--
It is more disgraceful to distrust than to be deceived by our friends.

Thanks for your reply. What I meant in e.g. 3 the cell contents in ColC could be "BOD 123456 12345678" <- As you can see I've 2 numeric values separated by a space, first has 6 numerics and the 2nd has 8 numerics

hi Sean,

Am Mon, 5 Aug 2013 07:42:05 -0700 (PDT) schrieb :

Thanks for your reply. What I meant in e.g. 3 the cell contents in ColC could be "BOD 123456 12345678" <- As you can see I've 2 numeric values separated by a space, first has 6 numerics and the 2nd has 8 numerics

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")
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 = "Job Not Done"
Case "BOD"
myStr = "Job Pending"
End Select
c.Offset(, 5) = myStr
End If
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

Thanks Claus, one Q, what part of your code has the numeric qualifiers I've mentioned?

Hi Sean,

Am Mon, 5 Aug 2013 08:12:46 -0700 (PDT) schrieb :

Thanks Claus, one Q, what part of your code has the numeric qualifiers I've mentioned?

the code searches in part of the cells. It don't look for numeric
values.


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

Hi Sean,

Am Mon, 5 Aug 2013 08:12:46 -0700 (PDT) schrieb :

Thanks Claus, one Q, what part of your code has the numeric qualifiers I've mentioned?

what do you mean with numeric qualifiers?
If D is empty and E greater than 0? That makes the IF-Statement when c
is not nothing.


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

Claus, as per Example 3

Test if:- There is the text "BOD" in Col C + there is also 6 numeric values & 8 numeric values also in Col C (can be any numeric value) + the value in Col D is blank but the value in Col E is 0 then place the text "Job Pending" in Col H

There might be text "BOD in Col C without the numeric values mentioned, in that instance I would want to place the text "Call Back" in Col H etc etc

Hi Sean,

Am Mon, 5 Aug 2013 08:35:01 -0700 (PDT) schrieb :

Test if:- There is the text "BOD" in Col C + there is also 6 numeric values & 8 numeric values also in Col C (can be any numeric value) + the value in Col D is blank but the value in Col E is 0 then place the text "Job Pending" in Col H

now I understand
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")
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, 5)), "Job Not Done", "")
Case "BOD"
myStr = IIf(IsNumeric(Mid(c, 5, 6)) And _
IsNumeric(Mid(c, 12, 8)), "Job Pending", "")
End Select
c.Offset(, 5) = myStr
End If
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

Claus thats pretty good, does pretty much what I want. One issue, the eg 3 that I mentioned, it doesn't place any text in the required cell. Maybe I'll clarify what the cell in Col C contains, it would look like "BOD 123456 12345678"

Hi Sean,

Am Mon, 5 Aug 2013 09:33:12 -0700 (PDT) schrieb :

Claus thats pretty good, does pretty much what I want. One issue, the eg 3 that I mentioned, it doesn't place any text in the required cell. Maybe I'll clarify what the cell in Col C contains, it would look like "BOD 123456 12345678"

in that case that Mid(c, 5, 6) AND Mid(c, 12, 8) are numeric it writes
"Job Pending" in my test book.
If you want "Call Back" if there are no numeric values in column C then
change this part of code:

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, 5)), "Job Not Done", "")
Case "BOD"
myStr = IIf(IsNumeric(Mid(c, 5, 6)) And _
IsNumeric(Mid(c, 12, 8)), "Job Pending", "Call Back")
End Select
c.Offset(, 5) = myStr
myStr = ""
End If

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

Mid(c, 5, 6) AND Mid(c, 12, 8) <-- What is the meaning of this part of the code?

Hi Sean,

Am Mon, 5 Aug 2013 09:51:25 -0700 (PDT) schrieb :

Mid(c, 5, 6) AND Mid(c, 12, 8) <-- What is the meaning of this part of the code?

c is the searched range. And if there is a numeric value beginning with
the 5. digit and 6 digits long and beginning with the 12. digit and 8
digits long then write "Job Pending"


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

Thanks, makes sense, couple more scenario's which I've tried but can't get to work

1) If Col C has text "Opening Sequence" and Col D&E are blank, then show "Over Risk" in Col H

2) If Col C has text "GLS" and also contains a 6 numeric value & an 8 numeric value in the cell + Col D is <0 + Col E is blank, then show "Duty Exceeded" in Col H

All previous code is good, so above is an appendix

Hi Sean,

Am Mon, 5 Aug 2013 10:09:00 -0700 (PDT) schrieb :

Thanks, makes sense, couple more scenario's which I've tried but can't get to work

1) If Col C has text "Opening Sequence" and Col D&E are blank, then show "Over Risk" in Col H

2) If Col C has text "GLS" and also contains a 6 numeric value & an 8 numeric value in the cell + Col D is <0 + Col E is blank, then show "Duty Exceeded" in Col H

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")
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
Select Case myArr(i)
Case "ABC"
myStr = IIf(Len(c.Offset(, 1)) = 0 _
And c.Offset(, 2) 0, "Job Done", "")
Case "Credit Transfer"
myStr = IIf(IsNumeric(Right(c, 6)) And Len(c.Offset(, 1)) = 0 _
And c.Offset(, 2) 0, "Job Not Done", "")
Case "BOD"
myStr = IIf(IsNumeric(Mid(c, 5, 6)) And IsNumeric(Mid(c, 12, 8))
_
And Len(c.Offset(, 1)) = 0 And c.Offset(, 2) 0, "Job
Pending", _
"Call Back")
Case "Opening Sequence"
myStr = IIf(Len(c.Offset(, 1)) = 0 And _
Len(c.Offset(, 2)) = 0, "Over Risk", "")
Case "GLS"
myStr = IIf(IsNumeric(Mid(c, 5, 6)) And IsNumeric(Mid(c, 12, 8))
And _
c.Offset(, 1) < 0 And Len(c.Offset(, 2)) = 0, "Duty Exceeded",
"")
End Select
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

Hi Sean,

sorry for the line breaks:

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")
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
Select Case myArr(i)
Case "ABC"
myStr = IIf(Len(c.Offset(, 1)) = 0 _
And c.Offset(, 2) 0, "Job Done", "")
Case "Credit Transfer"
myStr = IIf(IsNumeric(Right(c, 6)) And _
Len(c.Offset(, 1)) = 0 And c.Offset(, 2) 0, _
"Job Not Done", "")
Case "BOD"
myStr = IIf(IsNumeric(Mid(c, 5, 6)) And _
IsNumeric(Mid(c, 12, 8)) And Len(c.Offset(, 1)) = 0 _
And c.Offset(, 2) 0, "Job Pending", "Call Back")
Case "Opening Sequence"
myStr = IIf(Len(c.Offset(, 1)) = 0 And _
Len(c.Offset(, 2)) = 0, "Over Risk", "")
Case "GLS"
myStr = IIf(IsNumeric(Mid(c, 5, 6)) And _
IsNumeric(Mid(c, 12, 8)) And c.Offset(, 1) < 0 _
And Len(c.Offset(, 2)) = 0, "Duty Exceeded", "")
End Select
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

Clause, code works great, I'm trying to add another scenario, but I just get a <Blank in Col H

If Col C has text "XYZ" - it also contains other values but not worried about those + Col D is <0 + Col E is blank, then show "Level Top" in Col H

hi Sean,

Am Mon, 5 Aug 2013 11:09:03 -0700 (PDT) schrieb :

If Col C has text "XYZ" - it also contains other values but not worried about those + Col D is <0 + Col E is blank, then show "Level Top" in Col H

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
myStr = IIf(myArr(i) = "GLS" And IsNumeric(Mid(c, 5, 6)) And _
IsNumeric(Mid(c, 12, 8)), "Duty Exceeded", "")
myStr = IIf(myArr(i) = "XYZ", "Top Level", "")
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

Instead of re-doing the whole code I tried to appendix below, but it returns <blank in Col H. Note D is <0 and E is 0


Case "XYZ"
myStr = IIf(Len(c.Offset(, 1)) < 0 _
And c.Offset(, 2) = 0, "Top Level", "")

Hi Sean,

Am Mon, 5 Aug 2013 11:34:39 -0700 (PDT) schrieb :

Instead of re-doing the whole code I tried to appendix below, but it returns <blank in Col H. Note D is <0 and E is 0

the SELECT CASE statement is into the IF-statement that checks for D is
empty and E greater than 0. So "XYZ" cannot be found there
This new case (XYZ) belongs to the IF-statement that checks D < 0 and E
is empty.
Copy the complete code and replace the old one.


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

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", "")

The actual value in Col C for above would look like "GLS 123456 78901234" and it would have <0 in Col D and 0 in Col E

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

Bingo, that works great Claus, thanks for your help. Might have a few more scenarios to add, but thats it for today

One final one tonight!, below checks if "Credit Transfer" Appears in ColC and ALSO there is a value with 6 numerics, correct? If so can this be amended so that.....

"Credit Transfer" Appears in ColC and ALSO there is a value between 4 & 6 numerics

Case "Credit Transfer"
myStr = IIf(IsNumeric(Right(c, 6)), "Notes Lodged", "")

Hi Sean,

Am Mon, 5 Aug 2013 12:28:34 -0700 (PDT) schrieb :

Case "Credit Transfer"
myStr = IIf(IsNumeric(Right(c, 6)), "Notes Lodged", "")

try:
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


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

Claus could you explain what below is doing? I'm assuming its counting the characters in the cell

If Len(c) = 21 And IsNumeric(Right(c, 5)) Then

myStr = "Job Not Done"

Hi Sean,

Am Mon, 5 Aug 2013 13:06:41 -0700 (PDT) schrieb :

Claus could you explain what below is doing? I'm assuming its counting the characters in the cell

If Len(c) = 21 And IsNumeric(Right(c, 5)) Then

yes, it is counting the characters. Because if right(c,6) is numeric
right(c,5) is numeric too. So I looked for a difference and took the
length of the cell.
Is it not working correctly?


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

No, ok, forget that one, a new scenario that will cover this off

If Col C contains the text "Skydrive" AND it will also contain a numeric value ranging from between 3 and 5 digits

Am Mon, 5 Aug 2013 13:17:04 -0700 (PDT) schrieb :

No, ok, forget that one, a new scenario that will cover this off

If Col C contains the text "Skydrive" AND it will also contain a numeric value ranging from between 3 and 5 digits

and what is in D and E? And what should be write in H?


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

Sorry didn't complete it, Col D is <blank and ColE 0, in COL H will be "Dropbox"

Hi again,

Am Mon, 5 Aug 2013 13:26:56 -0700 (PDT) schrieb :

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.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Thanks for all the Code