Forum Discussion
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 that I do not need.
As this code will be run on very large worksheets I wanted a visual way to see exactly what the code is selecting before committing to the deletion. This is a safeguard for my poor coding skills.
so what this code does is it sets up the variables based on criteria working on finding the startRow and endRow based on the "Complete name" row and the preceding blank row.
Then it *SHOULD* colour the appropiate rows in yellow from Column A to C between startRow and endRow working its way up the whole sheet.
It then counts the number of rows with the yellow colour and prompts with a message box to delete the rows or not.
If I choose Yes, it deletes the rows with yellow color and then displays a message with the count of deleted rows.
If I choose No, it displays the count of rows marked for deletion and ends the sub so I can visually check it has selected the right rows.
The code below is the last in many different versions and it works up to a point.
It is the bits that do not work that I need a helping hand with please.
After running the sub, it only selects the first set of rows for deletion but not all of them working up all of the rows in the sheet.
If I click NO, it provides the message with the count of rows marked for deletion BUT it does not leave the selected rows coloured yellow.
If I click YES, it only deletes one set of rows but does not work all of the way up the sheet.
Sample workbook attached.
Sub HighlightDeleteRows()
Dim ws As Worksheet
Dim lastRow As Long
Dim cell As Range
Dim startRow As Long
Dim endRow As Long
Dim i As Long
Dim yellowCount As Integer
' 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
' 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
' 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 the color yellow
yellowCount = ws.Range("A" & startRow & ":A" & endRow - 1).SpecialCells(xlCellTypeConstants, 6).Count
' Ask user to delete rows
Dim answer As VbMsgBoxResult
answer = MsgBox("Delete Rows?", vbYesNo)
' Delete or Mark Rows based on user input
If answer = vbYes Then
' Delete rows with yellow color
ws.Range("A" & startRow & ":A" & endRow - 1).SpecialCells(xlCellTypeConstants, 6).EntireRow.Delete
MsgBox yellowCount & " Rows Deleted"
Else
MsgBox yellowCount & " Rows Marked For Deletion!"
End If
End Sub
- AshaKantaSharmaIron ContributorSub 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