Hi David

Thanks for your replies

I've applied both the formulas with no luck

Hope I can be more clear with this post, I have dug out an old post off a
floppy disk from a couple of years ago. I was working on a similar task when
I send a post and had replies from Patrick Molloy, which work ok. I have put
another example and the code below.

R AA AC
1 1 JOHN < this cell ( Would be Fill colour Red because AA4
= 1
2 2 JANE < this cell Would Not be red
3 0 JANE < this cell Would Not be red
4 1 JOHN < this cell Would Not be red because AA5 is not a
number 1
5 0 JOHN < this cell ( Would be Fill colour Red because AA7
= 1
6 5 JANE < this cell ( Would be Fill colour Red because AA8
= 1
7 1 JOHN < this cell Would Not be red
8 1 JANE < this cell Would Not be red

I have tried this code it works but it works up the columns, maybe then I
was entering new data at the top of the sheet. I would like to work down the
sheet and change the Font color to Fill color red.

Sub Fillred()
Dim aText() As String
Dim pointer As Long
Dim i As Long
Dim rw As Long
Dim clText As String
Dim clVal As String
clText = "AC"
clVal = "AA"
rw = 4
Do Until Cells(rw, clVal) = ""
If pointer 0 Then
For i = 1 To UBound(aText)
If aText(i) = Cells(rw, clText) Then
Cells(rw, clText).Font.Color = vbRed
aText(i) = ""
Exit For
End If
Next
End If
If Cells(rw, clVal) = 1 Then
pointer = pointer + 1
ReDim Preserve aText(1 To pointer)
aText(pointer) = Cells(rw, clText)
End If
rw = rw + 1
Loop
End Sub

Thanks in Advance

Dave

Dave,

How about this?

Sub Test()
Sub Test()
Dim iLastRow As Long
Dim i As Long
Dim cell As Range
Const kCol As String = "AC"

iLastRow = Cells(Rows.Count, kCol).End(xlUp).Row
For i = 1 To iLastRow - 1
Cells(i, kCol).Interior.ColorIndex = xlColorIndexNone
On Error Resume Next
Set cell = Nothing
Set cell = Range(kCol & i & ":" & kCol & iLastRow).Find(Cells(i,
kCol).Value)
On Error GoTo 0
If Not cell Is Nothing Then
If cell.Offset(0, -2).Value = 1 And cell.Address < Cells(i,
kCol).Address Then
Cells(i, kCol).Interior.ColorIndex = 3
End If
End If
Next i

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Dave" wrote in message
...
Hi David

Thanks for your replies

I've applied both the formulas with no luck

Hope I can be more clear with this post, I have dug out an old post off a
floppy disk from a couple of years ago. I was working on a similar task
when
I send a post and had replies from Patrick Molloy, which work ok. I have
put
another example and the code below.

R AA AC
1 1 JOHN < this cell ( Would be Fill colour Red because
AA4
= 1
2 2 JANE < this cell Would Not be red
3 0 JANE < this cell Would Not be red
4 1 JOHN < this cell Would Not be red because AA5 is not a
number 1
5 0 JOHN < this cell ( Would be Fill colour Red because
AA7
= 1
6 5 JANE < this cell ( Would be Fill colour Red because
AA8
= 1
7 1 JOHN < this cell Would Not be red
8 1 JANE < this cell Would Not be red

I have tried this code it works but it works up the columns, maybe then I
was entering new data at the top of the sheet. I would like to work down
the
sheet and change the Font color to Fill color red.

Sub Fillred()
Dim aText() As String
Dim pointer As Long
Dim i As Long
Dim rw As Long
Dim clText As String
Dim clVal As String
clText = "AC"
clVal = "AA"
rw = 4
Do Until Cells(rw, clVal) = ""
If pointer 0 Then
For i = 1 To UBound(aText)
If aText(i) = Cells(rw, clText) Then
Cells(rw, clText).Font.Color = vbRed
aText(i) = ""
Exit For
End If
Next
End If
If Cells(rw, clVal) = 1 Then
pointer = pointer + 1
ReDim Preserve aText(1 To pointer)
aText(pointer) = Cells(rw, clText)
End If
rw = rw + 1
Loop
End Sub

Thanks in Advance

Dave

Hi Bob

My post was not suppose to go here, but under my first post I haven't used
newsgroups for a while. I apologize to David McRitchie for my error.

Yes it worked a treat Bob, Thanks

Thanks to the both of you.



"Bob Phillips" wrote in message
...
Dave,

How about this?

Sub Test()
Sub Test()
Dim iLastRow As Long
Dim i As Long
Dim cell As Range
Const kCol As String = "AC"

iLastRow = Cells(Rows.Count, kCol).End(xlUp).Row
For i = 1 To iLastRow - 1
Cells(i, kCol).Interior.ColorIndex = xlColorIndexNone
On Error Resume Next
Set cell = Nothing
Set cell = Range(kCol & i & ":" & kCol & iLastRow).Find(Cells(i,
kCol).Value)
On Error GoTo 0
If Not cell Is Nothing Then
If cell.Offset(0, -2).Value = 1 And cell.Address < Cells(i,
kCol).Address Then
Cells(i, kCol).Interior.ColorIndex = 3
End If
End If
Next i

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Dave" wrote in message
...
Hi David

Thanks for your replies

I've applied both the formulas with no luck

Hope I can be more clear with this post, I have dug out an old post off a
floppy disk from a couple of years ago. I was working on a similar task
when
I send a post and had replies from Patrick Molloy, which work ok. I have
put
another example and the code below.

R AA AC
1 1 JOHN < this cell ( Would be Fill colour Red because
AA4
= 1
2 2 JANE < this cell Would Not be red
3 0 JANE < this cell Would Not be red
4 1 JOHN < this cell Would Not be red because AA5 is not
a
number 1
5 0 JOHN < this cell ( Would be Fill colour Red because
AA7
= 1
6 5 JANE < this cell ( Would be Fill colour Red because
AA8
= 1
7 1 JOHN < this cell Would Not be red
8 1 JANE < this cell Would Not be red

I have tried this code it works but it works up the columns, maybe then I
was entering new data at the top of the sheet. I would like to work down
the
sheet and change the Font color to Fill color red.

Sub Fillred()
Dim aText() As String
Dim pointer As Long
Dim i As Long
Dim rw As Long
Dim clText As String
Dim clVal As String
clText = "AC"
clVal = "AA"
rw = 4
Do Until Cells(rw, clVal) = ""
If pointer 0 Then
For i = 1 To UBound(aText)
If aText(i) = Cells(rw, clText) Then
Cells(rw, clText).Font.Color = vbRed
aText(i) = ""
Exit For
End If
Next
End If
If Cells(rw, clVal) = 1 Then
pointer = pointer + 1
ReDim Preserve aText(1 To pointer)
aText(pointer) = Cells(rw, clText)
End If
rw = rw + 1
Loop
End Sub

Thanks in Advance

Dave

You got the answer you were looking for, which is good, but
your example data shows
for Row 1 you are looking at row 4 (row 1 + 3)
for row 5 you are looking at row 6 instead of row 8
for row 6 you are looking at row 8 instead of row 9
and for conditional formatting formulas to work they have
to be a formula and I fail to see the connection between
varying row differences.

--
---
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm

"Dave" wrote in message ...
Hi Bob

My post was not suppose to go here, but under my first post I haven't used
newsgroups for a while. I apologize to David McRitchie for my error.

Yes it worked a treat Bob, Thanks

Thanks to the both of you.



"Bob Phillips" wrote in message
...
Dave,

How about this?

Sub Test()
Sub Test()
Dim iLastRow As Long
Dim i As Long
Dim cell As Range
Const kCol As String = "AC"

iLastRow = Cells(Rows.Count, kCol).End(xlUp).Row
For i = 1 To iLastRow - 1
Cells(i, kCol).Interior.ColorIndex = xlColorIndexNone
On Error Resume Next
Set cell = Nothing
Set cell = Range(kCol & i & ":" & kCol & iLastRow).Find(Cells(i,
kCol).Value)
On Error GoTo 0
If Not cell Is Nothing Then
If cell.Offset(0, -2).Value = 1 And cell.Address < Cells(i,
kCol).Address Then
Cells(i, kCol).Interior.ColorIndex = 3
End If
End If
Next i

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Dave" wrote in message
...
Hi David

Thanks for your replies

I've applied both the formulas with no luck

Hope I can be more clear with this post, I have dug out an old post off a
floppy disk from a couple of years ago. I was working on a similar task
when
I send a post and had replies from Patrick Molloy, which work ok. I have
put
another example and the code below.

R AA AC
1 1 JOHN < this cell ( Would be Fill colour Red because
AA4
= 1
2 2 JANE < this cell Would Not be red
3 0 JANE < this cell Would Not be red
4 1 JOHN < this cell Would Not be red because AA5 is not
a
number 1
5 0 JOHN < this cell ( Would be Fill colour Red because
AA7
= 1
6 5 JANE < this cell ( Would be Fill colour Red because
AA8
= 1
7 1 JOHN < this cell Would Not be red
8 1 JANE < this cell Would Not be red

I have tried this code it works but it works up the columns, maybe then I
was entering new data at the top of the sheet. I would like to work down
the
sheet and change the Font color to Fill color red.

Sub Fillred()
Dim aText() As String
Dim pointer As Long
Dim i As Long
Dim rw As Long
Dim clText As String
Dim clVal As String
clText = "AC"
clVal = "AA"
rw = 4
Do Until Cells(rw, clVal) = ""
If pointer 0 Then
For i = 1 To UBound(aText)
If aText(i) = Cells(rw, clText) Then
Cells(rw, clText).Font.Color = vbRed
aText(i) = ""
Exit For
End If
Next
End If
If Cells(rw, clVal) = 1 Then
pointer = pointer + 1
ReDim Preserve aText(1 To pointer)
aText(pointer) = Cells(rw, clText)
End If
rw = rw + 1
Loop
End Sub

Thanks in Advance

Dave