Error With a Do Until Loop

This piece of code was provided by someone else to help me - however he is unavailable and I am trying to get this project completed. If anyone here can help, I'd appreciate it.

The debugger gives me a compile error on the Loop at the bottom of the code. "Compile error - Loop without Do"!

Anyone see anything obvious please?

Kev

Sub SumNames()
    
Dim earn_count As Currency
Dim person_name As String
Dim i As Integer

i = 2   'starting row

    'get initial values
    Cells(i, 1).Activate
    person_name = Selection.Value
    earn_count = earn_count + Cells(i, 2).Value
    
    'loop until empty cell found:
    Do Until IsEmpty(ActiveCell)
        'check for matching name:
        If Cells(i + 1, 1).Value = person_name Then
            earn_count = earn_count + Cells(i + 1, 2).Value
        Else
            'routine to export person_name and earn_count goes here
            
            Call totname

            'set up ready for next person
            earn_count = Cells(i + 1, 2).Value
            person_name = Cells(i + 1, 1).Value
        
        'activate next row
        Cells(i + 1, 1).Activate
        'increment loop
        i = i + 1
    Loop

End Sub

This now seems to work thank you.