Search working but not correct!

Private Sub UserForm_Initialize()    Dim ws As Worksheet
    Dim v
    Dim n As Long
    Set ws = Worksheets("Data")
    v = ws.Range("PassportDate").Value
    For n = LBound(v) To UBound(v)
        v(n, 1) = Format(v(n, 1), "dd/mm/yyyy")
    Next
    Me.cboDateSearch.List = v
 End Sub
Private Sub AttendClearBtn_Click()
Application.ScreenUpdating = False
Unload AttendeeForm
AttendeeForm.Show
Application.ScreenUpdating = True
 End Sub




Private Sub AttendSearchBtn_Click()
On Error Resume Next
    Dim shCurrent As Worksheet
    Dim shResults As Worksheet
    Dim found As Range
    Dim firstFound As String
    Dim SrchCol_1 As String
    Dim SrchCol_2 As String
    Dim r As Long
    
    If cboDateSearch = "" And tbSrch2 = "" Then Exit Sub
    
    Set shData = Sheets("Users") 'change to suit
    Set rgData = shData.Cells.CurrentRegion
    Set rgData = rgData.Offset(1, 0).Resize(rgData.Rows.Count - 1, rgData.Columns.Count)
    
    Set shCurrent = ActiveSheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Results").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Results"
    Set shResults = Sheets("Results")
    With shResults
        .Cells(1, 1) = "ID"
        .Cells(1, 2) = "Staff Name" 'change to suit
        .Cells(1, 7) = "Location"
        .Cells(1, 8) = "Tutor"
    End With
    'columns to search thru - change to suit
    SrchCol_1 = "F"
    SrchCol_2 = "F"
    
    lbResList.ListIndex = -1
    StaffName = ""
    cboLocation = ""
    cboTutorsName = ""
    
    
    r = 1
    If cboDateSearch <> "" Then
        With rgData.Columns(SrchCol_1)
            Set found = .Find(cboDateSearch, rgData.Cells(rgData.Rows.Count, SrchCol_1))
            If Not found Is Nothing Then
                firstFound = found.Address
                Do
                    r = r + 1
                    found.EntireRow.Copy shResults.Cells(r, 1)
                    shResults.Cells(r, 1).Insert Shift:=xlToRight
                    shResults.Cells(r, 1) = found.Row
                    Set found = .FindNext(found)
                Loop While Not found Is Nothing And found.Address <> firstFound
            End If
        End With
    End If
    If tbSrch2 <> "" Then
        With rgData.Columns(SrchCol_2)
            Set found = .Find(tbSrch2, rgData.Cells(rgData.Rows.Count, SrchCol_2))
            If Not found Is Nothing Then
                firstFound = found.Address
                Do
                    r = r + 1
                    found.EntireRow.Copy shResults.Cells(r, 1)
                    shResults.Cells(r, 1).Insert Shift:=xlToRight
                    shResults.Cells(r, 1) = found.Row
                    Set found = .FindNext(found)
                Loop While Not found Is Nothing And found.Address <> firstFound
            End If
        End With
    End If
    If r = 1 Then
        lbResList.RowSource = ""
        MsgBox "There is no one booked for that date."
    Else
        Set rgResults = shResults.Cells.CurrentRegion
        Set rgResults = rgResults.Offset(1, 0).Resize(rgResults.Rows.Count - 1, rgResults.Columns.Count)
        rgResults.RemoveDuplicates Columns:=Array(1), Header:=xlNo
        Set rgResults = shResults.Cells.CurrentRegion
        Set rgResults = rgResults.Offset(1, 0).Resize(rgResults.Rows.Count - 1, rgResults.Columns.Count)
        ActiveWorkbook.Names.Add Name:="rgResults", RefersTo:=rgResults
        lbResList.RowSource = "rgResults"
    End If
    
    shCurrent.Activate
    Application.ScreenUpdating = True
End Sub
Private Sub AttendCloseBtn_Click()
Unload Me
End Sub