VBA Macro to delete unchecked rows using marlett check - excel

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