Would this work for you?
Code:
Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const LB_FINDSTRINGEXACT = &H1A2

Private Sub Form_Load()
    Dim i%
    
    For i = 0 To 30
        List1.AddItem Format(DateAdd("d", i, Date), "mm/dd/yyyy")
    Next i

End Sub

Private Sub DTPicker1_Change()
Dim strText$

    strText = Format(DTPicker1.Value, "mm/dd/yyyy")
    List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRINGEXACT, -1, ByVal strText)

End Sub