Dates in Userform restrictions

[rhombus4]

I want to enter a value into a textbox and check to make sure it is a valid date. Then it transfer to a cell when I hit a command button

If I start to enter the date then decide I dont need it I want to be able to delete what I have entered and still be able to transfer that textbox to a cell
or even If I dont enter anything in it at all let it transfer to the cell as blank

The code below works fine to check if a date is valid or not, although If I start to enter a date and then decide I don't want to on this particular occasion and hit the backspace key/ It wont let me move on to the rest of the form. I still get the message Date is not Valid.

I did try changing the cancel = False which seemed ok but then got an error when I wanted to transfer the date to a cell
run time error 13 type mismatch think because its trying to enter a blank "" in a cell

tried both below but got error when it tried to transfer to a cell when i had cleared the textbox after I had changed the code to cancel = false
Range("A2") = CDate(Me.textbox1.Value)
Range("A2") = Format(Me.textbox1, "dd/mmm/yy").Value

Private Sub textbox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    If Not IsDate(Me.textbox1.Text) Then
        MsgBox "Date is not Valid"

        Cancel = True
        Exit Sub
    End If

Me.textbox1 = Format(CDate(Me.textbox1), "dd mm yy")

End Sub

 

[eirikdaude]

I'd set the ok button for the userform to disabled by default, and add a check for whether the textbox contains a valid value. Something like:

Private Sub textbox1_Change()
    Call check_if_valid
End Sub

Private Sub check_if_valid()
    cmdOk.Enabled = CBool(Len(textbox1 > 0) And IsDate(textbox1))
End Sub

For a complete example of how I've done this in one of my userforms, you can see the sample code below. Note that to get this to work properly you'll also have to include this calendar control in your project (rewritten slightly to work with userforms instead of ranges).

Option Explicit

Private cancelled As Boolean
 
Public Property Get IsCancelled() As Boolean
    IsCancelled = cancelled
End Property

Private Sub UserForm_Initialize()
        
    tbxDatoHCP = Format(Date, "dd.mm.yyyy")
    
    With Me.cmbUtslag
        .AddItem "G(ult)"
        .AddItem "R(ødt)"
    End With
    
    With Me.cmbKlasse
        .AddItem "D(ame)"
        .AddItem "H(erre)"
    End With
    
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = VbQueryClose.vbFormControlMenu Then
        Cancel = True
        OnCancel
    End If
End Sub
 
Private Sub cmdOK_Click()
    Me.Hide
End Sub
 
Private Sub cmdAvbryt_Click()
    OnCancel
End Sub

Private Sub tbxDatoHCP_Enter()
    Dim frm As DatePickerForm
    
    Set frm = New DatePickerForm
    frm.current_date = Date + 1
    frm.Show
    If Not frm.IsCancelled Then
        tbxDatoHCP.Value = Format(frm.current_date, "dd.mm.yyyy")
        Unload frm
    End If
    Set frm = Nothing
    tbxHjemmeklubb.SetFocus
End Sub

Private Sub tbxHandicap_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
        Case 8 To 9, 12, 44, 48 To 57:
            If KeyAscii = 44 Then If InStr(1, tbxHandicap.Text, ",") Then KeyAscii = 0
        Case Else:
            KeyAscii = 0
            Beep
    End Select
End Sub

Private Sub cmbKlasse_Change()
    Call sjekk_utslag
    Call sjekk_om_utfylt
End Sub

Private Sub cmbUtslag_Change()
    Call sjekk_om_utfylt
End Sub

Private Sub tbxDatoHCP_Change()
    Call sjekk_om_utfylt
End Sub

Private Sub tbxEtternavn_Change()
    Call sjekk_om_utfylt
End Sub

Private Sub tbxFornavn_Change()
    Call sjekk_om_utfylt
End Sub

Private Sub tbxHandicap_Change()
    Call sjekk_om_utfylt
End Sub

Private Sub tbxHjemmeklubb_Change()
    Call sjekk_om_utfylt
End Sub

Private Sub sjekk_om_utfylt()
    cmdOK.Enabled = CBool(Len(tbxDatoHCP) > 0 And Len(tbxEtternavn) > 0 And Len(tbxFornavn) > 0 And Len(tbxHandicap) > 0 And Len(tbxHjemmeklubb) > 0 And Len(cmbKlasse) > 0 And Len(cmbUtslag) > 0)
End Sub

Private Sub sjekk_utslag()
    Dim funnet As Boolean
    Dim i As Long
    Const s As String = "G(ult)"
    
    If Trim(cmbKlasse) = "D(ame)" Then
        With cmbUtslag
            For i = .ListCount - 1 To 0 Step -1
                If .List(i) = s Then
                    .RemoveItem (i)
                    Exit For
                End If
            Next i
        End With
    Else
        With cmbUtslag
            funnet = False
            For i = .ListCount - 1 To 0 Step -1
                If .List(i) = s Then
                    funnet = True
                    Exit For
                End If
            Next i
            If Not funnet Then
                .AddItem s
            End If
        End With
    End If
End Sub

Private Sub OnCancel()
    cancelled = True
    Me.Hide
End Sub

 

[rhombus4]

Thanks

Maybe something to look at in future but seems alot of work just to transfer a date to a cell if it contains a valid date and a blank if if doesn't

 

[Fluff]

How about

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
   With Me.TextBox1
      If IsDate(.Text) Then
         .Value = Format(CDate(.Value), "dd mm yy")
      ElseIf Len(.Value) > 0 Then
         MsgBox "Date is not valid"
         Cancel = True
         Exit Sub
      End If
   End With
End Sub

 

[rhombus4]

Thanks Fluff

Although when I added a line to transfer to a sheet either in your code or in a submit code it wouldn't format properly.

When I entered 4/9/20 in the textbox it formatted as 4 Sep 20 but when it transferred to the sheet it was 04-Sep-20, even if the contents and format of that cell were cleared.

I know I could format the cells before as Custom dd mmm yy but is there a way to transfer it without having to format the cells manually.

Also what is the difference between
= Format(Me.TextBox1, "dd mmm yy")
= Format(CDate(Me.TextBox1), "dd mmm yy")

and
difference betwen these 3 the 1st one even though you change the number format to dd mmm yy the actual cell is text when you

Range("z1") = Me.Textbox1
Range("z1").NumberFormat = "dd mmm yy"

Range("z2") = Me.Textbox1.value
Range("z2").NumberFormat = "dd mmm yy"

Range("z3") = Me.Textbox1.text
Range("z3").NumberFormat = "dd mmm yy"

Private Sub Textbox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
   With Me.TextBox1
      If IsDate(.Text) Then
         .Value = Format(CDate(.Value), "dd mmm yy")
      Sheet1.Range("K3") = Format(Me.TextBox1, "dd mmm yy")
      Sheet1.Range("K4") = Format(CDate(Me.TextBox1), "dd mmm yy")
      ElseIf Len(.Value) > 0 Then
         MsgBox "Date is not valid"
         Cancel = True
         Exit Sub
      End If
   End With

End Sub

 

[Fluff]

Easiest way is to convert the date to a number

Sheet1.Range("K3") = CLng(Me.TextBox1)

& format the cell

 

[rhombus4]

Sheet1.Range("K3") = CLng(Me.TextBox1)

I get an error with that line

K3 transfers but K4 gets an error runtime error, type mismatch

Private Sub Textbox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
   With Me.TextBox1
      If IsDate(.Text) Then
         .Value = Format(CDate(.Value), "dd mmm yy")
        Sheet1.Range("K3") = Format(Me.TextBox1, "dd mmm yy") 'Formats as a Date although as dd-mmm-yy, unless you format the cell as dd mmm yy
        Sheet1.Range("K4") = CLng(Me.TextBox1)
        
      ElseIf Len(.Value) > 0 Then
         MsgBox "Date is not valid"
         Cancel = True
         Exit Sub
      End If
   End With

End Sub

 

[Fluff]

In that case try

Sheet1.Range("K3") = CLng(CDate(Me.TextBox1))

 

[rhombus4]

In that case try

Sheet1.Range("K3") = CLng(CDate(Me.TextBox1))

Thanks that worked. Do you know why the other one caused the error and whats the difference between the two lines below.

If you format the cells as dd mmm yy they both give the same result

Sheet1.Range("K3") = Format(Me.TextBox1, "dd mmm yy")
Sheet1.Range("K4") = CLng(CDate(Me.TextBox1))

 

[Fluff]

Handling dates in VBA is a right PITA especially if you don't use American style dates.
I have always found converting them to numbers is a lot easier & safer.