Populate listbox if search reference is duplicated

Hi

my userform searches based on the date. If it finds something it populates an amount into another textbox. So it is searching the date in column(A) then returning the corresponding value in column(B). If the date is duplicated it is meant to populate a listbox with all the dates and corresponding values which are duplicated.

I think it has something to do with the fact im searching based on the date, as I have another userform which searches based on a number and it does as it should.

So heres the code for the whole userform, the find features are in Sub cmbFind and SUb FindALL.

Option Explicit

Const frmHt As Long = 370
Const frmWidth As Long = 310
Const frmMax As Long = 500



Private Sub UserForm_Initialize()
    Me.Caption = "OOD Material" 'userform caption
    Me.Height = frmHt
    Me.Width = frmWidth
    Me.ScrollBar1.Min = 2
    Set ws = Worksheets("MasterColour")
    Me.ComboColour.List = ws.Range("ColourList").Value
    'change sheet name and Range here
    Set ws = ActiveWorkbook.Sheets("OOD")
'---The name is already set, so why do you need to rename it?---
'    ws.Name = "BasecoatLog"
    Set MyData = ws.Range("a2").CurrentRegion 'database
    Me.ScrollBar1.Max = MyData.Rows.Count

End Sub
Private Sub cmbAdd_Click()
        Dim r As Long
        
    On Error GoTo cmbAdd_Click_Error
    
    If IsEmpty(Me.ComboColour.Text) Then
        MsgBox "Please select a colour.", vbExclamation, "Missing data..."
        Me.ComboColour.SetFocus
        GoTo Cleanup
    End If
        
    If Not IsDate(Me.txtDate) Then
        MsgBox "Input must be a date in the format: 'dd/mm/yyyy'", _
            vbCritical, "Data Miss-Match"
        GoTo Cleanup
    Else
        Me.txtDate = Format(Me.txtDate, "dd/mm/yyyy")
    End If
    
    If Not IsDate(Me.txtScrap) Then
        MsgBox "Input must be a date in the format: 'dd/mm/yyyy'", _
            vbCritical, "Data Miss-Match"
        GoTo Cleanup
    Else
        Me.txtDate = Format(Me.txtScrap, "dd/mm/yyyy")
    End If

    r = FindLastRow(ws.Range("A:A")) + 1
    Application.ScreenUpdating = False 'speed up, hide task
    Application.EnableEvents = 0
    '---write userform entries to database
    ws.Cells(r, 1) = CDate(Me.txtDate)
    ws.Cells(r, 2).Value = Me.ComboColour.Value
    ws.Cells(r, 3).Value = Me.txtBody.Value
    ws.Cells(r, 4).Value = Me.txtam.Value
    ws.Cells(r, 6).Value = CDate(Me.txtScrap)
    '---Rather than using formula on the worksheet, _
        you can supply the values here---
    ws.Cells(r, 7).Value = Application.WorksheetFunction.WeekNum(CDate(Me.txtScrap))
    ws.Cells(r, 8).Value = MonthName(CDate(Me.txtScrap))
    ws.Cells(r, 9).Value = Month(CDate(Me.txtScrap))
    ws.Cells(r, 10).Value = Year(CDate(Me.txtScrap))
    
    '---clear the form---
    Call ClearControls

    Me.ScrollBar1.Max = MyData.Rows.Count

Cleanup:
    On Error Resume Next
    Application.ScreenUpdating = -1
    Application.EnableEvents = -1
    
Terminate:
    On Error GoTo 0

    Exit Sub

cmbAdd_Click_Error:

    MsgBox "There is an issue with cmbAdd_Click " & vbCrLf & vbCrLf & _
        Err.Number & " (" & Err.Description & ")", vbCritical, _
        "Something went wrong..."
    Resume Cleanup
    
End Sub
 
Private Sub cmbDelete_Click()
    Dim msgResponse As String 'confirm delete
    On Error GoTo cmbDelete_Click_Error

    Application.ScreenUpdating = False
     'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", _
    vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse 'action dependent on response
        Case vbYes
             'c has been selected by Find button
            c.EntireRow.Delete 'remove entry by deleting row
            Set MyData = ws.Range("a2").CurrentRegion 'database
             'restore form settings
            Me.cmbAmend.Enabled = False 'prevent accidental use
            Me.cmbDelete.Enabled = False 'prevent accidental use
            Me.cmbAdd.Enabled = True 'restore use
            Me.ScrollBar1.Max = MyData.Rows.Count
             'clear form
            ClearControls
        Case vbNo
            'Exit Sub 'cancelled
            GoTo Cleanup
    End Select

Cleanup:
    On Error Resume Next
    Application.ScreenUpdating = True
    
Terminate:
    On Error GoTo 0

    Exit Sub

cmbDelete_Click_Error:

    MsgBox "There is an issue with cmbDelete_Click " & vbCrLf & vbCrLf & _
        Err.Number & " (" & Err.Description & ")", vbCritical, _
        "Something went wrong..."

    Resume Cleanup
End Sub

Private Sub cmbFind_Click()
    Dim strFind As String 'what to find
    Dim FirstAddress As String
    Dim f As Integer
    mydate = Me.txtDate
     '    imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
    On Error GoTo cmbFind_Click_Error

    strFind = CDbl(mydate) 'what to look for
     
    MyData.AutoFilter
    '---You may need to find a different 'find' function _
        Or make the txtBody control a listbox of known Body Numbers---
    Set c = MyData.Find(strFind, LookIn:=xlValues)
    If Not c Is Nothing Then 'found it
        'load entry to form
        Me.ComboColour.Value = c.Offset(0, 1).Value
        Me.txtBody.Value = c.Offset(0, 2).Value
        Me.txtam.Value = c.Offset(0, 3).Value
        Me.txtScrap.Value = Format(c.Offset(0, 5).Text, "dd/mm/yyyy")
        Me.cmbAmend.Enabled = True 'allow amendment or
        Me.cmbDelete.Enabled = True 'allow record deletion
        Me.cmbAdd.Enabled = False 'don't want to duplicate record
        r = c.Row
        f = 0
        FirstAddress = c.Address
        Do
            f = f + 1 'count number of matching records
            Set c = MyData.FindNext(c)
        Loop While Not c Is Nothing And c.Address <> FirstAddress
        If f > 1 Then
            Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
                Case vbOK
                    FindAll
                Case vbCancel
                     'do nothing
            End Select
            Me.Height = frmMax
        End If
    Else
        MsgBox strFind & " not listed" 'search failed
    End If

Cleanup:
    On Error Resume Next

Terminate:
    On Error GoTo 0

    Exit Sub

cmbFind_Click_Error:

    MsgBox "There is an issue with cmbFind_Click " & vbCrLf & vbCrLf & _
        Err.Number & " (" & Err.Description & ")", vbCritical, _
        "Something went wrong..."
    Resume Cleanup
     
End Sub

Private Sub cmbAmend_Click()
    On Error GoTo cmbAmend_Click_Error

    Application.ScreenUpdating = False
    If r <= 0 Then GoTo Cleanup
    Set c = ws.Cells(r, 1)
    c.Value = Me.txtDate.Value ' write amendments to database
    c.Offset(0, 1).Value = Me.ComboColour.Value
    c.Offset(0, 2).Value = Me.txtBody.Value
    c.Offset(0, 3).Value = Me.txtam.Value
    c.Offset(0, 5).Value = Me.txtScrap.Value
    '---other values---
    c.Offset(0, 7).Value = Application.WorksheetFunction.WeekNum(CDate(Me.txtScrap))
    c.Offset(0, 8).Value = MonthName(Me.txtScrap)
    c.Offset(0, 9).Value = Month(Me.txtScrap)
    c.Offset(0, 10).Value = Year(Me.txtScrap)
     'restore Form
    Me.cmbAmend.Enabled = False
    Me.cmbDelete.Enabled = False
    Me.cmbAdd.Enabled = True
    ' ClearControls
    Me.Height = frmHt
    
    If Sheet9.AutoFilterMode Then Sheet9.Range("A2").AutoFilter

Cleanup:
    On Error Resume Next
    Application.ScreenUpdating = True

Terminate:
    On Error GoTo 0

    Exit Sub

cmbAmend_Click_Error:

    MsgBox "There is an issue with cmbAmend_Click " & vbCrLf & vbCrLf & _
        Err.Number & " (" & Err.Description & ")", vbCritical, _
        "Something went wrong..."
    Resume Cleanup
End Sub

Sub FindAll()
    Dim wesTemp As Worksheet
    Dim strFind As String 'what to find
    mydate = Me.txtDate
    strFind = CDbl(mydate)
     
    If Not ws.AutoFilterMode Then MyData.AutoFilter
     
    MyData.AutoFilter Field:=1, Criteria1:=strFind
     
    Me.ListBox1.Clear
    For Each c In MyData.Columns(1).SpecialCells(xlCellTypeVisible)
        Me.ListBox1.AddItem c.Value
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = c.Offset(0, 1).Value
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = c.Offset(0, 2).Value
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = c.Offset(0, 3).Value
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = c.Offset(0, 4).Value
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = c.Offset(0, 5).Value
        Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = c.Row
    Next c
     
End Sub

Private Sub cmdClear_click()
    Me.txtDate.Value = ""
    Me.txtScrap.Value = ""
    Me.txtBody.Value = ""
    Me.ComboColour.Value = ""
    Me.txtam.Value = ""
End Sub

Private Sub ListBox1_Click()

    If Me.ListBox1.ListIndex = -1 Then 'not selected
        MsgBox "No selection made", vbInformation, "Nothing to process"
    ElseIf Me.ListBox1.ListIndex >= 1 Then 'User has selected
        r = Val(Me.ListBox1.List(Me.ListBox1.ListIndex, Me.ListBox1.ColumnCount - 1))
    End If
    
    Me.txtDate.Value = Format(Me.ListBox1.List(Me.ListBox1.ListIndex, 0), "dd/mm/yyyy")
    Me.ComboColour.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
    Me.txtBody.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2)
    Me.txtam.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 3)
    Me.txtScrap.Value = Format(Me.ListBox1.List(Me.ListBox1.ListIndex, 4), "dd/mm/yyyy")
    Me.cmbAmend.Enabled = True 'allow amendment or
    Me.cmbDelete.Enabled = True 'allow record deletion
    Me.cmbAdd.Enabled = False 'don't want duplicate
     
End Sub
 
Private Sub ScrollBar1_Change()
    Dim rw As Long
    
    rw = Me.ScrollBar1.Value
    Me.cmbAmend.Enabled = False
    Me.cmbDelete.Enabled = False
    Me.cmbAdd.Enabled = True
    Me.txtDate.Value = Format(MyData.Cells(rw, 1).Value, "dd/mm/yyyy")
    Me.ComboColour.Value = MyData.Cells(rw, 2).Value
    Me.txtBody.Value = MyData.Cells(rw, 3).Value
    Me.txtam.Value = MyData.Cells(rw, 4).Value
    Me.txtScrap.Value = Format(MyData.Cells(rw, 6).Value, "dd/mm/yyyy")
     
End Sub

Private Sub txtDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Me.txtDate.Value = Format(Me.txtDate.Value, "dd/mm/yyyy")
End Sub
Private Sub txtScrap_beforeupdate(ByVal Cancel As MSForms.ReturnBoolean)
    Me.txtScrap.Value = Format(Me.txtScrap.Value, "dd/mm/yyy")
End Sub

Sub ClearControls()
    For Each oCtrl In Me.Controls
        Select Case TypeName(oCtrl)
            Case "TextBox": oCtrl.Value = Empty
        End Select
    Next oCtrl
End Sub

That article suggests using datevalue as the formatting method, if i used datevalue() instead of cdbl() would that run smoother?

But tried changing to what you said but still that didn't fix it