CODEWITHSUNDEEP
excelvbadelete-row
DriveShaft1234
DriveShaft1234

Reputation: 13

How to delete a row if the text matches a certain color

I need to delete an entire row if the text is let's say the color green. I made a code, but it ends up deleting the entire sheet and if I change the range in the code to a certain range, the code only deletes half of what I need at a time. How do I call the range to be the entire worksheet and how do I fix the deleting half at a time issue?

Here is my code so far:

Sub DeleteHighlights()
 
 Dim rng1 As Range

 Set rng1 = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
 Dim arr1: arr1 = rng1.Value
Range("rng1").Select
For Each cell In Selection
    If cell.Font.Color = vbGreen Then
        cell.delete
    End If
Next cell
End Sub

Upvotes: 0

Views: 55

Answers (2)

Black cat
Black cat

Reputation: 6271

The code takes the ActiveSheet.UsedRange and create a range of the deleting rows.

Sub DeleteHighlights()
 
 Dim rng1 As Range, row As Range, cell As Range
 Dim delrange As Range
 Set rng1 = ThisWorkbook.Worksheets("Sheet1").UsedRange
 'Dim arr1: arr1 = rng1.Value
For Each row In rng1.Rows
    For Each cell In row.Cells
    If cell.Font.Color = vbGreen Then
        If delrange Is Nothing Then
          Set delrange = row
        Else
          Set delrange = Union(delrange, row)
        End If
        Exit For
    End If
    Next cell
Next row
delrange.Delete
End Sub

CDP1802 suggestion:
Replace to: If Not delrange Is Nothing Then delrange.Delete just in case there are no rows to delete.

Upvotes: 0

CDP1802
CDP1802

Reputation: 16322

Option Explicit

Sub DeleteHighlights()
   
    Dim r As Range, c As Range, colRow As Collection, i As Long
    Set colRow = New Collection
    For Each r In ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion.Rows
        For Each c In r.Columns
            If c.Font.Color = vbGreen Then
                colRow.Add r, CStr(r.Row)
                Exit For
            End If
        Next
    Next
    ' delete rows scanning up
    Application.ScreenUpdating = False
    For i = colRow.Count To 1 Step -1
       colRow(i).Delete
    Next
    Application.ScreenUpdating = True
End Sub

Upvotes: 1

Related Questions