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
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
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.
0