Reverse Loop ignores some cells - vba

Question

I have written a small code that allow me to:
in a defined range (xrng) in column F, find all the cells that contain certain text and once found, select all the cells in the range A:G on the same row and delete them. I have a reverse loop, which work partially, as ignores some cells in the range, specifically the 2nd and the 3rd. Below a before and after pic:
Here my code:
Sub removeapp()
Dim g As Long, xrng As Range, lastrow As Long, i As Long
i = 4
lastrow = Cells(Rows.Count, "F").End(xlUp).Row
Set xrng = Range(Cells(lastrow, "F"), Cells(i, "F"))
For g = xrng.Count To i Step -1
If xrng.Cells(g).Value = "Adjustment" Or xrng.Cells(g).Value = "Approved" Then
Range(Cells(xrng.Cells(g).Row(), "A"), Cells(xrng.Cells(g).Row(), "G")).Delete
End If
Next
End Sub
Could you help me to figure out why?
Also, the code runs really slow... if you have any tip to make it slighlty faster would be great!

Answer 1

Try this, please:
Sub removeappOrig()
Dim xrng As Range, lastrow As Long, sh As Worksheet
Set sh = ActiveSheet 'good to put here your real sheet
lastrow = sh.Cells(sh.Rows.count, "F").End(xlUp).Row
Set xrng = sh.Range("A4:F" & lastrow)
xrng.AutoFilter field:=6, Criteria1:="=Adjustment", Operator:=xlOr, _
Criteria2:="=Approved", VisibleDropDown:=False
Application.DisplayAlerts = False
xrng.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
sh.AutoFilterMode = False
End Sub

Answer 2

The next code is also fast enough since it iterates between array elements (in memory), not deletes row by row (it creates a ranges Union) and delete all at once:
Private Sub remoRangesAtOnce()
Dim i As Long, lastRow As Long, sh As Worksheet
Dim arrF As Variant, rng As Range, rngDel As Range
Set sh = ActiveSheet 'please name it according to your sheet name
lastRow = sh.Cells(sh.Rows.count, "F").End(xlUp).Row
Set rng = sh.Range("F4:F" & lastRow)
arrF = rng.Value
For i = LBound(arrF) To UBound(arrF)
If arrF(i, 1) = "Adjustment" Or arrF(i, 1) = "Approved" Then
If rngDel Is Nothing Then
Set rngDel = sh.Range(sh.Range("A" & i + 3), sh.Range("F" & i + 3))
Else
Set rngDel = Union(rngDel, sh.Range(sh.Range("A" & i + 3), sh.Range("F" & i + 3)))
End If
End If
Next i
If Not rngDel Is Nothing Then rngDel.Delete xlShiftUp
End Sub