When one of the counters reaches the end of its array, add all of the remaining items in the other list to the output.

Private Sub cmdCompare_Click()
Dim list1 As Variant
Dim list2 As Variant
Dim i1 As Long
Dim i2 As Long
Dim max1 As Long
Dim max2 As Long
Dim results As String

    ' Get the values.
    list1 = Split(Trim$(txtList1.Text), vbCrLf)
    list2 = Split(Trim$(txtList2.Text), vbCrLf)

    ' Remove trailing empty entries.
    i1 = UBound(list1)
    Do While Len(Trim$(list1(i1))) = 0
        i1 = i1 - 1
    Loop
    ReDim Preserve list1(0 To i1)

    i2 = UBound(list2)
    Do While Len(Trim$(list2(i2))) = 0
        i2 = i2 - 1
    Loop
    ReDim Preserve list2(0 To i2)

    i1 = LBound(list1)
    i2 = LBound(list2)
    max1 = UBound(list1)
    max2 = UBound(list2)
    Do While i1 < max1 And i2 < max2
        If list1(i1) < list2(i2) Then
            ' List 1 item is missing from list 2.
            results = results & "< " & Format$(list1(i1)) & _
                vbCrLf
            i1 = i1 + 1
        ElseIf list1(i1) > list2(i2) Then
            ' List 2 item is missing from list 1.
            results = results & "  " & Format$(list2(i2)) & _
                " >" & vbCrLf
            i2 = i2 + 1
        Else
            ' This item is in both lists.
            i1 = i1 + 1
            i2 = i2 + 1
        End If
    Loop

    ' We've finished with one of the lists.
    ' Add the remaining items from the other.
    If i1 < max1 Then
        ' List 1 still has items.
        For i1 = i1 To max1
            results = results & "< " & Format$(list1(i1)) & _
                vbCrLf
        Next i1
    ElseIf i2 < max2 Then
        ' List 2 still has items.
        For i2 = i2 To max2
            results = results & "  " & Format$(list2(i2)) & _
                " >" & vbCrLf
        Next i2
    End If

    txtResults.Text = results
End Sub