Fill Missing Dates in Sequence

Hi,
Sample workbook attached.

I have the following code to insert rows where date is missing. It works great for the first few instances of a missing date, but ignores instances towards the bottom of the list. Can any one help please?

Sub fill_dates()


Dim lngBottomRow As Long
Dim blnContinue As Boolean
Dim i As Integer



blnContinue = True

Do Until blnContinue = False
    lngBottomRow = ActiveSheet.Range("A65536").End(xlUp).Row
    blnContinue = False
    For i = 3 To lngBottomRow
        If ActiveSheet.Cells(i, 1).Value - ActiveSheet.Cells(i - 1, 1).Value > 1 Then
            ActiveSheet.Rows(i).Insert Shift:=xlShiftDown
            ActiveSheet.Cells(i, 1).Value = ActiveSheet.Cells(i - 1, 1).Value + 1
    
        End If
    Next i
Loop

End Sub

Kind regards