Spy Journal 3.0 Filtering the web for you

A while ago a reader named Jeremy sent me a request. Sorry I took so long to respond Jeremy – but I’ve finally done this and here are the results.

How can I delete an entire row based on the font color in column A?

I want do delete every row between A2 and A1000 where the font color is black or automatic. I have tried various alterations of the codes below.

Jeremy supplied several procedures, none of which worked correctly.

I have built a very simple version that does what is needed. I know that this is not good code, but it provides a good starting point. And it works. Anybody who needs to use the guts of it (the selection and deletion based on the font colour) can take that and apply it to whatever ranges they need to.

Here is the scenario.

1. You have a range of cells that have been coloured with the automatic font colour. (this could be any colour – you would just need to change the colour index in the code.)
2. You have some items that have been coloured with a different colour.
3. You need to delete the entire row of any cell that has not been coloured specially, ie all the automatic colour cells.

Here is the code you need.

Sub DeleteColorRows()
'Deletes all cells that do not have an automatic colour font applied
'This could be replaced with any colour index
'Assumes that data to check and delete is in a contiguous block in a single column
'Assumes that the entire row is to be deleted
'Uses activecell selections for simplicity. These could be replaced with variables that refer to the ranges
     Dim startrow As Long
     Dim endrow As Long
     'starting row number here
     startrow = ActiveCell.Row
     'assuming data to check is in A Column
     endrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row + startrow
     'gets end row from the range - replace "A" with the actual column or a varaible that supplies it
     Do Until startrow > endrow
         If Selection.Font.ColorIndex = xlAutomatic Then
             Selection.EntireRow.Delete ' you could replace this with any other command to work on the selected cell/row
             endrow = endrow - 1
             'reduces the endrow count because there is now one less row
         Else
             Selection.Offset(1, 0).Activate
             'recognises that this is to be kept and shifts down to the next row
         End If
         startrow = ActiveCell.Row
         'increases the startrow variable to the current row
     Loop
End Sub