"So in the workbook where you want the red cells, in the worbook open event,
call a macro that opens you source workbook, gathers the data and places it
where you want" yes that right.

I still have a problem with :
set rng = Range("A1:Z30")
rng.SpecialCells(xlBlanks).Delete

It deletes the blank cells and shifts to the left while i want them to shift
up.
Also if i select the range i want (over 70,000 cells) it crashes. I don't
know if it is just due to my rubbish work PC.

"Tom Ogilvy" wrote:

So in the workbook where you want the red cells, in the worbook open event,
call a macro that opens you source workbook, gathers the dat and places it
where you want.

set rng = Range("A1:Z30")
rng.SpecialCells(xlBlanks).Delete

worked fine for me as a demonstration. It assumes there are some blank
cells in the range.

--
Regards,
Tom Ogilvy


"TomK" wrote in message
...
I have been a little unclear.. I don't need a new workbook created each
time.
I just would like the file of all the red text in a seperate workbook. I
would like that each time this work book is opened it 'reads' the
[Overall5.xls]Programme sheet and organizes all the red text as described.

When i run the code you gave i get a run time error '1004' at the
rng.SpecialCells(xlBlanks).Delete line (i haven't had time to look into
why
yet)

Thanks for your help


"Tom Ogilvy" wrote:

Do you want a macro to create this new look each time your run the macro
or
are you looking for a formula approach?

I would suggest copying the sheet, then deleting any value that is not
colored red, then removing all blank cells. The results would be static
and
assumes that the data is already laid out under date as you show your
desired results. If that is the case


Sub ProcessSheet()
Dim rng as Range, cell as Range
Dim rng1 as Range
Activesheet.copy ' creates a new single sheet workbook
' the activesheet is now the new worksheet
set rng = Activesheet.UsedRange
set rng = rng.offset(1,0) ' retain header row
' remove formulas
rng.formula = rng.Value
set rng1 = rng.specialCells(xlConstants)
for each cell in rng1
if cell.font.colorIndex < 3 then
cell.ClearContents
end if
Next
rng.SpecialCells(xlBlanks).Delete
End sub

Overall5.xls must be open and the Sheet Programme must be the
activesheet
when you run the macro.



--
Regards,
Tom Ogilvy



"TomK" wrote in message
...
Hi,

I have a work sheet with the date as the column header and hundreds of
rows.
Most of the cells are blank but some contain values. Each value is
coloured
due to the 'stage' it is in. Basically i want to read these 1000's of
cells
and find all the values in red text. I already have this code to do it:

Function FontColor(R As Range) As Integer
Application.Volatile True
FontColor = R.Font.ColorIndex
End Function

But i want to organize the cells (in a separate workbook) to skip all
the
blank cells so the new workbook looks like:

Date Date Date etc etc
Redtext Redtext3 Redtext4
Redtext2

at the moment my work book has a formulas like:

=IF(AND(FontColor('[Overall5.xls]Programme'!V5)=3,'[Overall5.xls]Programme'!V5<0),'[Overall5.xls]Programme'!V5,"")

in every cell. This takes to long to update (it crashes if i don't have
the
'Overall5' workbook open) and doesn't organize them how i would like. I
have
tried using filters to organize the data afterwards but i am sure there
is
a
better more efficient way of doing it.

Thanks for any help

Tom