VBA date problem.

[erivien]

I have a problem with a VBA form.

the code in question gets a date from a cell in the worksheet and displays it in a text box input. (theadate)
it displays dd/mm/yyyy

The user has the option to change it via a tickbox (thedate)
then they change it and then when they press the command button the code saves the new date in the cell.
it saves mm/dd/yyyy

its confusing the dates because of the inane americans!

the code looks like:

Private Sub UserForm_Initialize()
    Dim shtActive As Worksheet
    Set shtActive = Application.Workbooks("system.xls").Worksheets("stats")
    theadate = shtActive.Range("d2").Value
End Sub

Private Sub complete_Click()
    Dim shtActive As Worksheet
    Set shtActive = Application.Workbooks("system.xls").Worksheets("stats")
    If thedate = False Then
        shtActive.Range("d2").Value = theadate.Value
    Else
        shtActive.Range("d2").Formula = "=TODAY()"
    End If
    Unload fsettings
End Sub

thanks for any help

regards

 

[al_b_cnu]

Hi,

At an appropriate point, try

shtActive.Range("d2").Numberformat = "ddmmyyyy"

HTH

alan

 

[earlyd]

How about separating the date into 3 fields?

- From of the inane ones

 

[earlyd]

Oops that's "from one of the inane ones" See?

 

[erivien]

ye im sorri bout that :P... though i do stand by the inane comment. You do spell colour and center better but the american date is ilogical!

As the cell in question is already formatted in the dd/mm/yyyy format. It is the value that the vba is writing to it, eg (34650) that is the problem because date formatting is just displaying dd/mm/yyyy from the value...

I'll just make 3 fields makes it simpler
thanks for your help though...

 

[Andrew Poulsom]

This worked for me:

Range("A1").Value = DateValue(theadate.Text)

The VBA DateValue function recognizes the order for month, day, and year according to the Short Date format you specified for your system.

 

[erivien]

thanks thats gr8

 

[erivien]

i now have one small problem... When the form does the initialize it displays the mm/dd/yyyy in the text box although the cell is dd/mm/yyyy (i perhaps did not notice this before as its the 2nd of febuary!

I would also like to put some kind of mask on the field so a user can only enter:
dd/mm/yyyy
if they enter
333 it will not accept the third 3. a user must use a / as the 3rd and 6th value while the others must be numbers. at the moment i am using this:

Private Sub theadate_Change()
    Dim Char As String
    Char = UCase(Right(theadate.Text, 1))
    If Char Like "#" Then
        Exit Sub
    ElseIf Char Like "/" Then
        Exit Sub
    Else
        Beep
        On Error Resume Next
        theadate.Text = Left(theadate.Text, Len(theadate.Text) - 1)
        theadate.SelStart = Len(theadate.Text)
    End If
End Sub

and the field has a max length of 10, however i need to really set the correct constraints on the slashes.

These are such little things that no doubt the end user will take for granted but i am somewhat of a perfectionist lol...

 

[erivien]

bump ^ i know bumping is annoying but i have another problem that was a product of this solution, kinda. I have sorted the first of the probelms above with a format() but...

The masking validation is still a problem.

any help is appreciated

 

[Andrew Poulsom]

This should give the right date in the TextBox:

theadate = Format(shtActive.Range("d2").Value,"dd/mm/yy")

And here is a mask:

Private Sub TextBox1_Change()
    Dim Char As String
    Dim x As Date
    Dim y As Date
    Char = Right(TextBox1.Text, 1)
    Select Case Len(TextBox1.Text)
    Case 1 To 2, 4 To 5, 7 To 8
        If Char Like "#" Then
            If Len(TextBox1) = 8 Then
                On Error Resume Next
                x = DateValue(TextBox1.Text)
                y = DateSerial(Right(TextBox1, 2), Mid(TextBox1, 4, 2), Left(TextBox1, 2))
                If Err = 0 And x = y Then
                    On Error GoTo 0
                    Exit Sub
                Else
                    Err.Clear
                    On Error GoTo 0
                    TextBox1.SelStart = 0
                    TextBox1.SelLength = Len(TextBox1.Text)
                    MsgBox "Please enter a valid date in the form dd/mm/yy", vbCritical + vbOKOnly, "Error"
                    Exit Sub
                End If
            Else
                Exit Sub
            End If
        End If
    Case 3, 6
        If Char Like "/" Then Exit Sub
    End Select
    Beep
    On Error Resume Next
    TextBox1.Text = Left(TextBox1.Text, Len(TextBox1.Text) - 1)
    TextBox1.SelStart = Len(TextBox1.Text)
End Sub