Yardım TextBox Tarih Kısmı

Private Sub TextBox1_Change()
    Select Case Mid(TextBox1.Text, 1, 1)
        Case Is = 0, 1, 2
            Select Case Mid(TextBox1.Text, 2, 1)
                Case Is = 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
                Case Else
                    TextBox1.Text = Mid(TextBox1.Text, 1, 1)
            End Select
        Case Is = 3
            Select Case Mid(TextBox1.Text, 2, 1)
                Case Is = 0, 1
                Case Else
                    TextBox1.Text = Mid(TextBox1.Text, 1, 1)
            End Select
        Case Else
            TextBox1.Text = Empty
    End Select
    
    Select Case Len(TextBox1.Text)
        Case Is = 2
            TextBox1.Text = TextBox1.Text & "/"
        Case Is = 5
            TextBox1.Text = TextBox1.Text & "/"
        Case Is >= 10
            If CLng(Mid(TextBox1.Text, 7, 4)) < 1901 Or _
            CLng(Mid(TextBox1.Text, 7, 4)) > 2100 Then
                MsgBox "Lütfen geçerli bir tarih giriniz", vbExclamation, "Www.ExcelArsivi.Com"
                TextBox1.Text = Empty
                Exit Sub
            Else
                TextBox1.Text = Mid(TextBox1.Text, 1, 10)
            End If
    End Select
    
    Select Case Mid(TextBox1.Text, 4, 1)
        Case Is = 0
        Case Is = 1
            Select Case Mid(TextBox1.Text, 5, 1)
                Case Is = 0, 1, 2
                Case Else
                    TextBox1.Text = Mid(TextBox1.Text, 1, 4)
            End Select
        Case Else
            TextBox1.Text = Mid(TextBox1.Text, 1, 3)
    End Select
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Not IsDate(TextBox1.Text) Then
        MsgBox "Lütfen geçerli bir tarih giriniz", vbExclamation, "Www.ExcelArsivi.Com"
        TextBox1.Text = Empty
    End If
End Sub