Delete rows with Red text

[richiwatts]

Hi,

I am a total Excel beginner so please excuse me if there is already a fucntion in Excel to do this.

Is it possible to have a macro that would delete the entire row if any cell in column D contains some red text. Not all the text in the cell is red and maybe just one word.

 

[VBABEGINER]

Hi,
Welcome to MrExcel Board,

select your excel sheet - press alt + f11 - code window open then - paste this code here - then you can see two drop down list - in 1st you will see by default (General) - select workbook there - as soon as you select workbook - in code window "workbook_open" event automatically comes - you can paste that code inside this.

even if you have any problem, do not hesitate to reply.
U will learn all excel funda on Mrexcel Board.

Public Function fnRemoveColorText()
Dim i, j
j = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To j
If ActiveSheet.Cells(i, 1).Font.ColorIndex = 3 Then
ActiveSheet.Cells(i, 1).Select
Selection.EntireRow.Delete
End If
Next
End Function

 

[Peter_SSs]

VBABEGINER, just a couple of comments about your code.

Apart from your code acting on a different column to that stated by the OP, your code will fail in these two circumstances:

1. If two successive rows contain red text, one of them will not be deleted. When deleting rows like this it's generall best to work from bottom to top.

2. If the first character or moe in the cell are not red but then some red characters occur, the row will not be deleted. Note the final sentence in the original post.


richiwatts, try this code in a copy of your workbook.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> DelRedRws()<br>    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, L <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> RedFound <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    lr = Range("D" & Rows.Count).End(xlUp).Row<br>    <SPAN style="color:#00007F">For</SPAN> r = lr <SPAN style="color:#00007F">To</SPAN> 1 <SPAN style="color:#00007F">Step</SPAN> -1<br>        RedFound = <SPAN style="color:#00007F">False</SPAN><br>        i = 0<br>        <SPAN style="color:#00007F">With</SPAN> Range("D" & r)<br>            L = Len(.Value)<br>            <SPAN style="color:#00007F">Do</SPAN><br>                i = i + 1<br>                <SPAN style="color:#00007F">If</SPAN> .Characters(i, 1).Font.ColorIndex = 3 <SPAN style="color:#00007F">Then</SPAN><br>                    RedFound = <SPAN style="color:#00007F">True</SPAN><br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">Until</SPAN> RedFound = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#00007F">Or</SPAN> i = L<br>            <SPAN style="color:#00007F">If</SPAN> RedFound <SPAN style="color:#00007F">Then</SPAN><br>                Rows(r).Delete<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> r<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[richiwatts]

I couldn't get it to work. I left it running for 2 hours and then I just killed the process. We have about 3000 rows

 

[Peter_SSs]

I haven't tested with that many rows and it would also depend on how many characters are in column D of each of those 3000 rows as the code needs to check character by character until it finds a red one or comes to the end of the cell.

It could also be that your 'red' is not ColorIndex 3. To check, find a cell with a red character and run this code after adjusting the two 'Const' lines to point at the cell and character that is red.
If it returns a number other than 3, you would need to change that number in my code.

Finally, test in a smaller worksheet to see if you can get it working.

Sub FindFontColour()
    Const myCell As String = "D9"
    Const myCharacterNumber As Long = 2
    
    MsgBox "Font colour of character " & myCharacterNumber & _
        " in cell " & myCell & " is " & _
        Range("D9").Characters(myCharacterNumber, 1).Font.ColorIndex
End Sub

 

[Rick Rothstein]

If the only color that non-black characters can be is red, then this code will work fairly quickly...

Sub DeleteRowsWithAnyRedCharacters()
  Dim X As Long
  Application.FindFormat.Clear
  Application.FindFormat.Font.ColorIndex = 3
  Columns("D").Replace "*", "#N/A", SearchFormat:=True
  Application.FindFormat.Clear
  For X = 1 To Cells(Rows.Count, "D").End(xlUp).Row
    If IsNull(Cells(X, "D").Font.ColorIndex) Then Cells(X, "D").Value = "#N/A"
  Next
  Columns("D").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
End Sub

However, if you can have characters that are other colors than red, then this will work, but more slowly (more than likely faster than Peter's code though)...

Sub DeleteRowsWithAnyRedCharacters()
  Dim X As Long, Z As Long
  Application.FindFormat.Clear
  Application.FindFormat.Font.ColorIndex = 3
  Columns("D").Replace "*", "#N/A", SearchFormat:=True
  Application.FindFormat.Clear
  For X = 1 To Cells(Rows.Count, "D").End(xlUp).Row
    If IsNull(Cells(X, "D").Font.ColorIndex) Then
      For Z = 1 To Len(Cells(X, "D").Value)
        If Cells(X, "D").Characters(Z, 1).Font.ColorIndex = 3 Then
          Cells(X, "D").Value = "#N/A"
          Exit For
        End If
      Next
    End If
  Next
  Columns("D").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
End Sub

 

[Jim885]

Rick,
I don't know if I will ever need your code in the future, but I also copied it to a macro-enabled Excel 2010 file I created that contains about 100 rows. It worked perfectly, and within a milli-second !!

Thanks!

 

[richiwatts]

Hi Rick,
The first one worked perfectly in less than a second. Is it possible to hide the rows instead of deleting them?

 

[Rick Rothstein]

Hi Rick,
The first one worked perfectly in less than a second. Is it possible to hide the rows instead of deleting them?

Just change the this line of code...

Columns("D").SpecialCells(xlConstants, xlErrors).EntireRow.Delete

to this...

Columns("D").SpecialCells(xlConstants, xlErrors).EntireRow.Hidden = True

I highlighted the parts that change in red for you. Note... you would make this same change in either of the macros I posted.

 

[richiwatts]

Thank you very much kind sir. Works like a treat and will save me hours.