excel vba date issue

Question

I only just noticed this, I have an application where a user tends to fill in information for three dates. A start date, an end date and a drop dead date. an example of one of those date boxes are listed below

Private Sub txtEDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

     'Dim dDate As Date
    dDate = DateSerial(Year(Date), Month(Date), Day(Date))
    txtEDate.Value = Format(txtEDate.Value, "dd/mm/yyyy")
    dDate = txtEDate.Value = ""
End Sub

the problem ive now noticed is when I pick dates say 1/3/2012 or 5/6/2012 when I commit these dates, they get changed around on my sheet to 3/1/2012 and 6/5 respectively. If my date input is 13/6/2012 it will stay as its not in the 12 month range. The excel sheet is the same format as what I've set me form as. Perhaps its a problem where I commit the date.

Private Sub cmdOK_Click()
Dim checks As Integer

trim.trimALL
Call Check_Correct_Data_Entry_Total(checks)

If checks = 1 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Name..."
    Me.txtName.SetFocus
End If

If checks = 2 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Number..."
    Me.txtPhone.SetFocus
End If
If checks = 3 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a ID..."
    Me.txtID.SetFocus
End If
If checks = 4 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Department.."
    Me.txtDepartment.SetFocus
End If
If checks = 5 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a End Date.. "
    Me.txtEDate.SetFocus
End If
If checks = 6 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Analysis Dead Date.. "
    Me.txtDeadDate.SetFocus
End If
If checks = 7 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Analysis..."
    Me.cboAnalysis.SetFocus
End If
If checks = 8 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Application..."
    Me.cboApplication.SetFocus
End If
If checks = 9 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter amount of Disk Space you will be using..."
    Me.txtDisks.SetFocus
End If

If checks = 10 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Cluster..."
    Me.cboCluster.SetFocus
End If
If checks = 11 Then
    frmCourseBooking.Error_Messages.Caption = "ERROR: Please enter a Core Amount..."
    Me.cboCores.SetFocus
End If

If checks = 0 Then

    ActiveWorkbook.Sheets("Course Bookings").Activate

    Dim Row_to_Record_Data As Long

    Row_to_Record_Data = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

    'Generate Unique Key for each new entry (Key = string of userid + numeric timestamp + random 3 letter string)

    Dim DateNumber As Long
    Dim RandomString1 As String
    Dim RandomString2 As String
    Dim RandomString3 As String
    Dim RandomString As String

    Dim Unique_Key As String

    DateNumber = Date
    RandomString1 = Chr(Application.WorksheetFunction.RandBetween(65, 90))
    RandomString2 = Chr(Application.WorksheetFunction.RandBetween(65, 90))
    RandomString3 = Chr(Application.WorksheetFunction.RandBetween(65, 90))
    RandomString = RandomString1 & RandomString2 & RandomString3
    Unique_Key = Format(Hour(Now), "00") & Format(Minute(Now), "00") & Format(Second(Now), "00") & RandomString

    'Check if overwriting entry selected from frmList ListBox
    If Overwrite_Row <> 0 Then Row_to_Record_Data = Overwrite_Row

    Cells(Row_to_Record_Data, 1).Value = txtName.Value
    Cells(Row_to_Record_Data, 2) = txtPhone.Value
    Cells(Row_to_Record_Data, 3) = LCase(txtID.Value)
    Cells(Row_to_Record_Data, 4) = txtDepartment.Value

    Cells(Row_to_Record_Data, 5) = cboAnalysis.Value
    Cells(Row_to_Record_Data, 6) = cboApplication.Value

   'ActiveCell.Offset(0, 7) = cboPriority.Value saved for priority to fill in off administration form

    Cells(Row_to_Record_Data, 9) = txtSDate.Value
    Cells(Row_to_Record_Data, 10) = txtDeadDate.Value
    'ADD ESTIMATED DATE HERE!!!!.
    Cells(Row_to_Record_Data, 11) = txtEDate.Value
    Cells(Row_to_Record_Data, 12) = cboCluster.Value
    Cells(Row_to_Record_Data, 13) = cboCores.Value
    Cells(Row_to_Record_Data, 14) = txtDisks.Value
    Cells(Row_to_Record_Data, 16) = txt_sge_number.Value


    'DVM CHOICES option.
    If optDefinition = True Then
        Cells(Row_to_Record_Data, 7).Value = "Definition"
    ElseIf optValidation = True Then
        Cells(Row_to_Record_Data, 7).Value = "Validation"
    Else
        Cells(Row_to_Record_Data, 7).Value = "Methods"
    End If

    'Enter Unique Key if new entry
    If Overwrite_Row = 0 Then Cells(Row_to_Record_Data, 15).Value = Unique_Key

End If

'frmCourseBooking.Error_Messages.Caption =

    Range("A1").Select

'clear form to avoid mishaps
If Overwrite_Row = 0 Then
    Accecptance_label.Caption = "Adding New Request, Recommend Clear Form After."
Else
    Accecptance_label.Caption = "Editted Request, Recommend Clear Form After."
End If

If checks = 0 Then
    Error_Messages.Caption = ""
End If

'Reset Overwrite_Row to zero
Overwrite_Row = 0


End Sub

this is the full function of me committing those dates to my form. in particular it is the Cells(Row_to_Record_Data, 1).Value = txtName.Value. My question is how can I get it to stick with the format I set it as in the form and not change once its committed?

Thanks in advance

Are you setting the sheet with the string? That is, are you using `Cell.Value = dDate` or `Cell.Value = txtEDate.Value`? Using `Cell.Value = dDate` should avoid the problem. Format "dd/mm/yyyy" is special. If you set the format of a cell to "dd/mm/yyyy" and then display the NumberFormat of that cell you will get "mm/dd/yyyy". The date formats marked with an asterisk exhibit this property. I always use unambiguous formats such as "dd mmm yyyy". See my question http://stackoverflow.com/q/9839676/973283 for extra information. — Tony Dallimore, Jul 17 '12 at 17:33
to name the input in each of the cells it follows the first code section. but if I put cell.value=dDate it would give me todays date as dDate is set as Date. how would I adapt the first code chunk where it's txtEdate section to keep it in the UK format I intend? I read your thread and just trying to get to grasps with it now — Zenaphor, Jul 18 '12 at 06:40
right ive put it to the "dd mmm yyyy" format then told my sheet to show it in short date, and it seems to be displaying properly now, thanks for the reply — Zenaphor, Jul 18 '12 at 07:12

score 0 · Answer 1 · answered Jul 18 '12 at 07:14

Private Sub txtEDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)       
'Dim dDate As Date    
 dDate = DateSerial(Year(Date), Month(Date), Day(Date))     
txtEDate.Value = Format(txtEDate.Value, "dd mmm yyyy")     
dDate = txtEDate.Value = "" 
End Sub

answer modified from input from @Tony Dallimore

excel vba date issue

1 Answers1