Hi

Hope someone can help,

In the column A i have data starting at A4 which could end at any row


What i want to happen is if the data font is blue it copys the valu
and pastes it two cells down from the last cell with a value. There ma
be more than one value which is in blue font so then it should copy an
paste to the last cell + 3 etc.

I also wanted to add some predefined text when it copied it in the sam
cell. E.g. "This 'value' does not meet our criteria"

I would be grateful if anyone could also give a brief explanation o
their solution.

Thank

--
Message posted from http://www.ExcelForum.com

Dim rng as Range, cell as Range
Dim rw as Long
set rng = Range(Cells(4,1),Cells(rows.count,1).end(xlup))
rw = rng(rng.rows.count)(3).row
for each cell in rng
if cell.font.colorIndex = 5 then
cell.copy destination:=cells(rw,1)
rw = rw + 1
end if
Next

if the font color is produced by conditional formatting, then you can't
check the font color directly. You would need to check the same conditions
as conditional formatting is checking.

--
Regards,
Tom Ogilvy

"infojmac " wrote in message
...
Hi

Hope someone can help,

In the column A i have data starting at A4 which could end at any row.


What i want to happen is if the data font is blue it copys the value
and pastes it two cells down from the last cell with a value. There may
be more than one value which is in blue font so then it should copy and
paste to the last cell + 3 etc.

I also wanted to add some predefined text when it copied it in the same
cell. E.g. "This 'value' does not meet our criteria"

I would be grateful if anyone could also give a brief explanation of
their solution.

Thanks


---
Message posted from http://www.ExcelForum.com/

info,

This is what I came up with. There will be other ways.


Charles

Sub move_text()
Dim rng As Range, finalrow As Range
Dim i As Integer
Dim firstloop As Boolean
firstloop = True
Set rng = Worksheets("sheet1").Cells(4, 1).CurrentRegion
Set finalrow = Range("A65536").End(xlUp)
For i = 1 To rng.Rows.Count
If rng(i, 1).Font.ColorIndex = 5 Then
If firstloop = True Then
finalrow.Offset(2, 0) = rng(i, 1).Value & " This is
test"
firstloop = False
Else
Set finalrow = Range("A65536").End(xlUp)
finalrow.Offset(1, 0) = rng(i, 1).Value & " This is a t"
End If
End If
Next
End Su

--
Message posted from http://www.ExcelForum.com

That seems to do the job.

Thanks very much

--
Message posted from http://www.ExcelForum.com

Thats done the job,

Thanks very much.


---
Message posted from http://www.ExcelForum.com/

Thats done the job,

Thanks very much

--
Message posted from http://www.ExcelForum.com