Forum Discussion
Kenneth Green
May 17, 2024Brass Contributor
Excel 2019. VBA select rows on criteria and delete up whole sheet, not looping up through the data?
EXCEL 2019 Windows 10 I receive large text files that contain rows of data that I need to keep, and some that I do not. The code below is designed to select, colour and then delete those rows th...
AshaKantaSharma
Aug 20, 2024Iron Contributor
Sub HighlightDeleteRows()
Dim ws As Worksheet
Dim lastRow As Long
Dim startRow As Long
Dim endRow As Long
Dim i As Long
Dim cell As Range
Dim yellowCount As Integer
Dim deleteRange As Range
Dim answer As VbMsgBoxResult
' Set the worksheet
Set ws = ThisWorkbook.Worksheets("Media")
' Find the last used row in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Initialize variables
startRow = 0
endRow = 0
yellowCount = 0
Set deleteRange = Nothing
' Loop from the last used row up to find the first cell with the text "Complete name"
For i = lastRow To 1 Step -1
If ws.Cells(i, 1).Value = "Complete name" Then
startRow = i + 1
Exit For
End If
Next i
' Find the endRow by looking for the first blank row above startRow
For i = startRow - 1 To 1 Step -1
If WorksheetFunction.CountA(ws.Rows(i)) = 0 Then
endRow = i + 1
Exit For
End If
Next i
' If startRow or endRow are not set correctly, exit the sub
If startRow = 0 Or endRow = 0 Then
MsgBox "No valid rows to process."
Exit Sub
End If
' Color rows in between startRow and endRow from Column A to C
For i = startRow To endRow - 1
ws.Range("A" & i & ":C" & i).Interior.Color = RGB(255, 255, 0) ' Yellow color RGB value
Next i
' Count the number of rows with yellow color and set up range for deletion
For i = startRow To endRow - 1
If ws.Range("A" & i & ":C" & i).Interior.Color = RGB(255, 255, 0) Then
yellowCount = yellowCount + 1
If deleteRange Is Nothing Then
Set deleteRange = ws.Rows(i)
Else
Set deleteRange = Union(deleteRange, ws.Rows(i))
End If
End If
Next i
' Ask user to delete rows
answer = MsgBox("Delete " & yellowCount & " Rows?", vbYesNo)
' Delete or Mark Rows based on user input
If answer = vbYes Then
If Not deleteRange Is Nothing Then
deleteRange.Delete
MsgBox yellowCount & " Rows Deleted"
End If
Else
MsgBox yellowCount & " Rows Marked For Deletion!"
End If
End Sub
Dim ws As Worksheet
Dim lastRow As Long
Dim startRow As Long
Dim endRow As Long
Dim i As Long
Dim cell As Range
Dim yellowCount As Integer
Dim deleteRange As Range
Dim answer As VbMsgBoxResult
' Set the worksheet
Set ws = ThisWorkbook.Worksheets("Media")
' Find the last used row in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Initialize variables
startRow = 0
endRow = 0
yellowCount = 0
Set deleteRange = Nothing
' Loop from the last used row up to find the first cell with the text "Complete name"
For i = lastRow To 1 Step -1
If ws.Cells(i, 1).Value = "Complete name" Then
startRow = i + 1
Exit For
End If
Next i
' Find the endRow by looking for the first blank row above startRow
For i = startRow - 1 To 1 Step -1
If WorksheetFunction.CountA(ws.Rows(i)) = 0 Then
endRow = i + 1
Exit For
End If
Next i
' If startRow or endRow are not set correctly, exit the sub
If startRow = 0 Or endRow = 0 Then
MsgBox "No valid rows to process."
Exit Sub
End If
' Color rows in between startRow and endRow from Column A to C
For i = startRow To endRow - 1
ws.Range("A" & i & ":C" & i).Interior.Color = RGB(255, 255, 0) ' Yellow color RGB value
Next i
' Count the number of rows with yellow color and set up range for deletion
For i = startRow To endRow - 1
If ws.Range("A" & i & ":C" & i).Interior.Color = RGB(255, 255, 0) Then
yellowCount = yellowCount + 1
If deleteRange Is Nothing Then
Set deleteRange = ws.Rows(i)
Else
Set deleteRange = Union(deleteRange, ws.Rows(i))
End If
End If
Next i
' Ask user to delete rows
answer = MsgBox("Delete " & yellowCount & " Rows?", vbYesNo)
' Delete or Mark Rows based on user input
If answer = vbYes Then
If Not deleteRange Is Nothing Then
deleteRange.Delete
MsgBox yellowCount & " Rows Deleted"
End If
Else
MsgBox yellowCount & " Rows Marked For Deletion!"
End If
End Sub