I have a Userform that populates Textboxes with dates from a worksheet. The idea is to be able to edit the dates and save them back to the worksheet. The problem is the dates show up in American format, not European. I understand that I need to use code to force the date to show as European. So I have tried using this code
Dim LValue As String
LValue = Format(Date, "dd/mm/YYYY")
I then have a function to populate the form, where I want the correct date format to show
Sub PopulateForm()
Me.Location.Value = rngFound(1, 0).Value
Me.ID.Value = rngFound(1, 1).Value
Me.FirstName.Value = rngFound(1, 2).Value
Me.LastName.Value = rngFound(1, 3).Value
Me.Grade = rngFound(1, 4).Value
Me.ARLFam = rngFound(1, 8).Value
Me.ARLEvac = rngFound(1, 11).Value
Me.HRDFam = rngFound(1, 16).Value
Me.HRDEvac = rngFound(1, 19).Value
Me.CRDFam = rngFound(1, 24).Value
Me.CRDEvac = rngFound(1, 27).Value
Me.RSQFam = rngFound(1, 32).Value
Me.RSQEvac = rngFound(1, 35).Value
Me.COVFam = rngFound(1, 40).Value
Me.COVEvac = rngFound(1, 43).Value
Me.LSQFam = rngFound(1, 48).Value
Me.LSQEvac = rngFound(1, 51).Value
Me.HPCFam = rngFound(1, 56).Value
Me.HPCTrackFam = rngFound(1, 63).Value
Me.HPCEvac = rngFound(1, 59).Value
Me.KNBFam = rngFound(1, 67).Value
Me.KNBEvac = rngFound(1, 70).Value
End Sub
I haven't figured out where to place LValue in the sub routine for it to change the dates to the correct format. Am I on the right track? Or am I barking up the wrong tree?
Next, when I have changed the dates and save the changes to the worksheet, I encounter a new problem. The cells the dates go into are set up as dates, and other cells have formulas working off the information provided by the date cells. When I save the dates from the Userform, they show up in the correct cells, but all the other cells reading from the date cell now have the #Value error showing. This is the code used to save the new dates to the worksheet.
Private Sub EnterButton_Click()
Dim LR As Long
Dim replace As Long
Dim response As Long
Dim LValue As String
LValue = Format(Date, "dd/mm/YYYY")
If Me.ID.Value = "" Then
MsgBox "You have not entered an ID."
Me.ID.SetFocus
Exit Sub
End If
FindRecord (Val(Me.ID))
If Not rngFound Is Nothing Then
replace = MsgBox("This record already exists in this Database." & vbNewLine _
& "Replace?", vbYesNo)
If replace = vbYes Then
LR = rngFound.Row
Else
ClearForm
Me.ID.SetFocus
Exit Sub
End If
Else
LR = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
With ws
.Cells(LR, 1).Value = Me.Location
.Cells(LR, 2).Value = Val(Me.ID)
.Cells(LR, 3).Value = Me.FirstName
.Cells(LR, 4).Value = Me.LastName
.Cells(LR, 5).Value = Me.Grade
.Cells(LR, 9).Value = Me.ARLFam
.Cells(LR, 12).Value = Me.ARLEvac
.Cells(LR, 17).Value = Me.HRDFam
.Cells(LR, 20).Value = Me.HRDEvac
.Cells(LR, 25).Value = Me.CRDFam
.Cells(LR, 28).Value = Me.CRDEvac
.Cells(LR, 33).Value = Me.RSQFam
.Cells(LR, 36).Value = Me.RSQEvac
.Cells(LR, 41).Value = Me.COVFam
.Cells(LR, 44).Value = Me.COVEvac
.Cells(LR, 49).Value = Me.LSQFam
.Cells(LR, 52).Value = Me.LSQEvac
.Cells(LR, 57).Value = Me.HPCFam
.Cells(LR, 64).Value = Me.HPCTrackFam
.Cells(LR, 60).Value = Me.HPCEvac
.Cells(LR, 68).Value = Me.KNBFam
.Cells(LR, 71).Value = Me.KNBEvac
End With
If replace = vbYes Then
MsgBox "The existing record on " & ws.Name & " row# " & rngFound.Row & " was overwitten"
Else
MsgBox "The record was written to " & ws.Name & " row# " & LR
End If
response = MsgBox("Do you want to enter another record?", _
vbYesNo)
If response = vbYes Then
ClearForm
Me.ID.SetFocus
Else
Unload Me
End If
End Sub
Is it because the date has been saved as text instead of a date? If so, how do I get it to save as a European date?
The following assumes that you have real dates in Excel (you can prove this for example by formatting a cell containing a date as General: It should display a number).
Background: dates are stored internally as numbers, the integer part gives the
Date-part, counting the number of days starting from 1. January 1900. The fraction part is representing the time, 1/3 would be 8am (a third of the day)
A textbox in VBA contains always a String. When you want to write a date into the textbox and use code like tbStartDate = ActiveSheet.Cells("B2") and B2 contains a date, you are asking VBA to convert the date into a string. VBA will do so, but it has it's own rules for that and so you end up with a string that looks like an US date. Basically, you should always avoid that VBA does an automatic conversion for you. Instead, use a function for that: Format it the right function to convert a Date or a number into a string, you use it already correctly in the first 2 statements. To write the date into the textbox, you now write
tbStartDate = Format(ActiveSheet.Cells("B2"), "dd/mm/YYYY")
Now comes the tricky part: The user may change the date and you want to write it back to the cell. Again, you shouldn't let Excel do the conversion implicitly. The problem is that with a normal text box you cannot prevent that the user enters rubbish stuff (you might read Formatting MM/DD/YYYY dates in textbox in VBA).
But let's assume your user enters the date in the "correct" form: How do you convert a string into a date?
You often see the answer to use CDate that converts a string into a date, respecting the locale setting of the system. Fine, as long as all users have the same settings. But if you might have a user coming with a Laptop freshly imported from the US or that comes from any other part of the world, you have the same problem again: VBA will convert the date with wrong assumptions (eg changing the day- and month part).
Therefore I usually use a small custom function that splits the string and use the parts as parameters into another VBA function DateSerial. It will return 0 (=1.1.1900) if the input is complete nonsense, but doesn't check all invalid possibilities. A 13 as input is happily accepted (DateSerial, btw, accepts this also).
Function StrToDate(s As String) As Date
' Assumes input as dd/mm/yyyy or dd.mm.yyyy
Dim dateParts() As String
dateParts = Split(Replace(s, ".", "/"), "/") ' Will work with "." and "/"
If UBound(dateParts) <> 2 Then Exit Function
Dim yyyy As Long, mm As Long, dd As Long
dd = Val(dateParts(0))
mm = Val(dateParts(1))
yyyy = Val(dateParts(2))
If dd = 0 Or mm = 0 Or yyyy = 0 Then Exit Function
StrToDate = DateSerial(yyyy, mm, dd)
End Function
Now, writing the input back to the cell could be like
dim d as Date
d = StrToDate(tbStartdate)
if d > 0 then ActiveSheet.cells(B2) = d