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

Sub fill_dates()
  With Activesheet
    for j= .Range("A65536").End(xlUp).Row to 3 step -1
        If .Cells(j, 1).Value - .Cells(j - 1, 1).Value > 1 Then
          .Rows(j).Insert
          .Cells(j, 1).Value = .Cells(j - 1, 1).Value + 1
        End If
    Next 
  End With
End Sub

Without trying the rest of your code try this

    For i = lngBottomRow To 3 Step -1
        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

Hope this helps