Excel 2019. VBA select rows on criteria and delete up whole sheet, not looping up through the data?

Brass Contributor

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

 

 

 

 

 

0 Replies