VBA Macro to delete unchecked rows using marlett check

Question

I don't really have much of a background in VBA, but I'm trying to create a macro where, on the push of a button all rows that do not have a check mark in them in a certain range are deleted. I browsed some forums, and learned about a "marlett" check, where the character "a" in that font is displayed as a check mark. Here is the code I have to generate the "marlett check" automatically when clicking a cell in the A column in the appropriate range:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("A10:A111")) Is Nothing Then
            Target.Font.Name = "Marlett"
                If Target = vbNullString Then
                    Target = "a"
                Else
                    Target = vbNullString
                End If
        End If

End Sub

I then have another macro (assigned to a button) that actually deletes the rows without a check mark in the "A" column when the button is pressed:

Sub delete_rows()

Dim c As Range

On Error Resume Next
For Each c in Range("A10:A111")
    If c.Value <> "a" Then
        c.EntireRow.Delete
    End If
Next c

End Sub

Everything works, but the only problem is that I have to press the button multiple times before all of the unchecked rows are deleted!! It seems like my loop is not working properly -- can anyone please help??

Thanks!

Answer 1

I think this may be due to how you're deleting the rows, you might be skipping a row after every delete.

You might want to change your for-each for a regular for loop. so you can control the index you'r working on. see this answer or the other answers to the question to see how to do it.

Heres a modified version that should suit your (possible) problem.

Sub Main()
    Dim Row As Long
    Dim Sheet As Worksheet
    Row = 10
    Set Sheet = Worksheets("Sheet1")
    Application.ScreenUpdating = False
    Do
        If Sheet.Cells(Row, 1).Value = "a" Then
            'Sheet.Rows(Row).Delete xlShiftUp
            Row = Row + 1
        Else
            'Row = Row + 1
            Sheet.Rows(Row).Delete xlShiftUp
        End If
    Loop While Row <= 111
    Application.ScreenUpdating = True
End Sub

Update Try the edit I've made to the if block, bit of a guess. Will look at it when I have excel.

It does go into an infinite loop regardless of the suggested change. The problem was when it got near the end of your data it continually found empty rows (as theres no more data!) so it kept deleting them.

The code below should work though.

Sub Main()
    Dim Row As Long: Row = 10
    Dim Count As Long: Count = 0
    Dim Sheet As Worksheet
    Set Sheet = Worksheets("Sheet1")
    Application.ScreenUpdating = False
    Do
        If Sheet.Cells(Row, 1).Value = "a" Then
            Row = Row + 1
        Else
            Count = Count + 1
            Sheet.Rows(Row).Delete xlShiftUp
        End If
    Loop While Row <= 111 And Row + Count <= 111
    Application.ScreenUpdating = True
End Sub