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
you surely can change the current forat into an european one and here is some examples of how you can uses it :
Sub dates_et_heures()
'Now renvoie la date et l'heure en cours (07.02.2018 09:09:02)
date_test = Now()
'Renvoie : 07.02.18
Range("A1") = Format(date_test, "dd.mm.yy")
'Renvoie : mardi 7 février 2018
Range("A2") = Format(date_test, "dddd d mmmm yyyy")
'Renvoie : Mardi 7 Février 2018
Range("A3") = WorksheetFunction.Proper(Format(date_test, "dddd d mmmm yyyy"))
'Renvoie : mar. 07
Range("A4") = Format(date_test, "ddd dd")
'Renvoie : MAR 07
Range("A5") = "'" & Replace(UCase(Format(date_test, "ddd dd")), ".", "")
'Renvoie : FÉVRIER 2018
Range("A6") = UCase(Format(date_test, "mmmm yyyy"))
'Renvoie : 07.02.2018 09:09
Range("A7") = Format(date_test, "dd.mm.yyyy hh:mm")
'Renvoie : Le 7 février à 9h09'02''
Range("A8") = Format(date_test, "Le d mmmm à h\hmm'ss''")
'Renvoie : 9H09
Range("A9") = Format(date_test, "h\Hmm")
End Sub
I don't have the answer for the second part but i hope this could help too
Related
One of our spreadsheets requires a userform. When trying to paste the user's values to the sheet housing the data, I get error code 13: type mismatch.
All the fields are textboxes. One line of code identical except the address of where we're posting the information works.
Here's what I have:
Public Sub btnSubmit_Click()
Dim TableSht As Worksheet
Dim NextRow As Long
Set TableSht = ThisWorkbook.Sheets("Table")
TableSht.Visible = True
'https://www.mrexcel.com/forum/excel-questions/1017033-making-all-fields-userform-mandatory.html#post4880848
'determine if any fields were left blank
For Each Control In Me.Controls '
Select Case TypeName(Control)
Case "TextBox"
If Control.Value = vbNullString Then
MsgBox "empty field in " & Control.Name
Exit For
End If
Case Else
End Select
Next Control
'data is housed in E3:J3, E5:J5, E7:J7, E9:J9. if statement determines what row information
'should be entered on.
If TableSht.Range("E3") = "" Then
NextRow = 3
ElseIf TableSht.Range("E5") = "" Then
NextRow = 5
ElseIf TableSht.Range("E7") = "" Then
NextRow = 7
ElseIf TableSht.Range("E9") = "" Then
NextRow = 9
Else
MsgBox ("There are no more available rows. Contact Craig for additional assistance.")
End If
'paste the user's data entry into the appropriate cells
With TableSht
.Cells(NextRow, 5) = Me.tbOwner
.Cells(NextRow, 6) = CDate(Me.tbDate)
.Cells(NextRow, 7) = Me.tbChange
'Me.tbChange.Value = CDec(Me.tbChange) 'no longer use this but one of my attempts
.Cells(NextRow, 8) = Me.tbAmount
.Cells(NextRow, 9) = Me.tbOriginal
.Cells(NextRow, 10) = Me.tbReason
.Cells(NextRow, 7).Value = Format(Range("G" & NextRow) / 100, "0.00%")
.Cells(NextRow, 8).Value = Format(Range("H" & NextRow), "$##.##")
.Cells(NextRow, 9).Value = Format(Range("I" & NextRow) / 100, "0.00%")
End With
Sheets("Rate Calculator v8").Select
TableSht.Visible = xlVeryHidden
Unload Me
End
End Sub
The error occurs on
.Cells(NextRow, 7).Value = Format(Range("G" & NextRow) / 100, "0.00%")
There's no error if I remove the line and cycle through the two after it, even though the last line before "end with" is essentially the same statement.
I've tried swapping the two lines of code that are similar. "Cells(NextRow, 7)..." and ".Cells(NextRow, 9)..." but the error still shows up on the "Cells(NextRow, 7)..." line.
I've confirmed the cells the data is pasted in columns G and I are both formatted as "percentage".
Qualify your Range usage with a sheet. If the sheet is also TableSht, the below should work. If the Range is from a different sheet, qualify that sheet
= Format(.Range("G" & NextRow) / 100, "0.00%")
= Format(.Range("H" & NextRow), "$##.##")
= Format(.Range("I" & NextRow) / 100, "0.00%")
I'm trying to get a month from a cell that contains a date? I'm trying to do the following. But it throws a Run-time error #13 that the types don't match. How would you go about doing this, I've tried many solutions but it just doesn't work.
In my stylesheet I have this where I put start and end values and have blank spaces for the Macro to write in
Sub Search()
Dim accountTxt As String
Dim propertyTxt As String
Dim startMonth As Integer
Dim endMonth As Integer
Dim iAccount As String
Dim iProperty As String
Dim acum As Integer
Dim rowMonth As Integer
accountTxt = ActiveSheet.Cells(2, 17).Text
propertyTxt = ActiveSheet.Cells(3, 17).Text
startMonth = ActiveSheet.Cells(5, 17).Value
endMonth = ActiveSheet.Cells(6, 17).Value
For i = 1 To 800
iAccount = ActiveSheet.Cells(i, 8).Value
iProperty = ActiveSheet.Cells(i, 7).Value
rowMonth = Month(ActiveSheet.Cells(i, 1).Value)
If rowMonth >= startMonth And rowMonth <= endMonth Then
If InStr(1, iAccount, accountTxt) Then
Cells(i, 12).Interior.ColorIndex = 4
acum = acum + Cells(i, 12).Value
End If
End If
Next i
Cells(8, 17).Value = acum
End Sub
Say we have something in B9 like:
It may be a real date or just a string that looks like a date. In either case:
Sub PerhapsADate()
Dim s As String, MonthAsNumber As Long
Dim MonthAsString As String
s = Range("B9").Text
MonthAsNumber = --Split(s, "/")(0)
MonthAsString = Format(CDate(s), "mmmm")
MsgBox MonthAsNumber & vbCrLf & MonthAsString
End Sub
will get the month as both a number or a string:
To parlay off of Gary's Student's answer:
Sub PerhapsADate()
Dim s As Date, MonthAsNumber As Long
Dim MonthAsString As String
s = Range("B9").Text
MonthAsNumber = DatePart("m", s)
MonthAsString = Format(s, "mmmm")
MsgBox MonthAsNumber & vbCrLf & MonthAsString
End Sub
This solution differs slightly in that typing "s" as a date forces the text to be recognized as a date and therefore will be less prone to failure where international date format standards vary.
I got a type mismatch because the iterator starts reading the Date column at the "Date" heading and not the date value (e.g. 01-10-2017)
I'm trying to combine the data from a date column and a time column. I'm using the following code:
Sub Concat()
Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lRow
Cells(i, 10) = Cells(i, 6) & " " & Cells(i, 7)
Cells(i, 11) = Cells(i, 8) & " " & Cells(i, 9)
Next I
Cells(1, 9).Copy
Cells(1, 10).PasteSpecial Paste:=xlPasteFormats
Cells(1, 11).PasteSpecial Paste:=xlPasteFormats
Cells(1, 10) = "Request Time"
Cells(1, 11) = "Validation Time"
End Sub
the result I get is this:
Input data:
Creation_Date Creation Time Change Date Change Time Request Time Validation Time
01/23/2017 8:20:10 01/23/2017 8:20:10 1/23/2017 0.347337962962963 1/23/2017 0.347337962962963
The time turns into a decimal that cannot be converted back to a time. before concatenate function, the date column is formatted for date and the time column is formatted to time.
Please help.
The underlying data type of a date/time format is most likely a 64-bit floating. I would suggest converting to String the values before concatenating and after that, applying the datetime format.
You could change your loop as follows:
For i = 2 To lRow
Cells(i, 10) = Cells(i, 6) + Cells(i, 7)
Cells(i, 11) = Cells(i, 8) + Cells(i, 9)
Cells(i, 10).NumberFormat = "m/dd/yyyy h:mm:ss"
Cells(i, 11).NumberFormat = "m/dd/yyyy h:mm:ss"
Next I
Of course, the formatting of columns J & K could be done in Excel, rather than in code, if that was easier for you.
The important thing is to just add the date and the time, not to try and create a string with the values joined together. (The time 8:20:10 is just a number which is equal to 8/24 + 20/24/60 + 10/24/60/60, i.e. 0.347337962962963, which is why the resultant string was being created as 1/23/2017 0.347337962962963 and, once it was a string then Excel is going to have a hard time treating it as anything else.)
I have found a way to display a message box based on a condition, however, the date format that appears is not what I would like to display or what is being displayed in my worksheet. Cells(i, 4).Value is the date value that I want to display as "mmmm dd, yyyy" but it displays as "m/d/yyyy". My actual Excel data has the date as "mmmm dd, yyyy".
I have tried multiple ways to format the date but I keep getting an error message. Is it possible to change the date format within the message box?
Sub Alert()
Dim i As Long
i = 3
While Workbooks("Issuers.xlsm").Sheets("Summary of Covered Companies").Cells(i, 5) <> ""
With Workbooks("Issuers.xlsm")
If .Sheets("Summary of Covered Companies").Cells(i, 5).Value = 1 Then
MsgBox Workbooks("Issuers.xlsm").Sheets("Summary of Covered Companies").Cells(i, 3).Value & " is issuing their next financial statement tomorrow (" & _
Workbooks("Issuers.xlsm").Sheets("Summary of Covered Companies").Cells(i, 4).Value & ")."
End If
End With
i = i + 1
Wend
End Sub
The following should fix it
MsgBox Workbooks("Issuers.xlsm").Sheets("Summary of Covered Companies").Cells(i, 3).Value & " is issuing their next financial statement tomorrow (" & _
Format(Workbooks("Issuers.xlsm").Sheets("Summary of Covered Companies").Cells(i, 4).Value,"[$-409]mmmm d, yyyy;#") & ")."
PS: Use macro recorder for getting most excel commands such as number formats
I think you can get what you want by using .text property intead of .value
Try this example:
Sub Alert()
Dim i As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim strDisplayDate As String
Dim strCompany As String
i = 3
Set wb = Workbooks("Issuers.xlsm")
Set ws = wb.Sheets("Summary of Covered Companies")
With ws
While .Cells(i, 5) <> ""
If .Cells(i, 5).Value = 1 Then
strCompany = .Cells(i, 3).Value
' Use text not value to store what's displayed on screen
strDisplayDate = .Cells(i, 4).Text
strMessage = strCompany & " is issuing their next financial statement tomorrow (" & strDisplayDate & ")."
MsgBox strMessage
End If
i = i + 1
Wend
End With
End Sub
If you really do want to format the value yourself, you can use .Value2 to get the underlying value like Format(.Cells(i,4,Value2),"mmmm dd, yyyy")
I'm working on a program with Excel's VBA functionality, but ran into a very strange logic error.
For SheetIndex = 1 To 6
With ActiveSheet
For ColIndex = 2 To 6
For DateIndex = 0 To MinLimit
datethingy = .Cells(1, ColIndex).Value
If (.Cells(1, ColIndex).Value = Date_Array(DateIndex, 1)) Then
For RowIndex = 2 To 11
' Compare every time slot value here to every time slot value in the array
datethingy = Trim(CStr(.Cells(RowIndex, 1).Value)) 'ERROR OCCURS HERE
If (Trim(CStr(.Cells(RowIndex, 1).Value)) = Date_Array(DateIndex, 2)) Then
.Cells(RowIndex, ColIndex).Value = "Checked"
End If
Next
End If
Next
Next
End With
SheetIndex = SheetIndex + 1
Application.Worksheets(SheetIndex).Activate
Next
So in the code above, I go through a series of cell values and make comparisons to values I already have in my array. However, when I draw the values from the cells, rather than "8:30", it comes up as "0.354166666...7". I have no idea why it's coming up like this, I'm even making sure it's being compared as a string and not as an int or anything else.
Here is where I set the values for the sheet's cells.
.Cells(2, 1).Value = "8:30"
.Cells(3, 1).Value = "9:00"
.Cells(4, 1).Value = "10:15"
.Cells(5, 1).Value = "11:30"
.Cells(6, 1).Value = "12:30"
.Cells(7, 1).Value = "13:30"
.Cells(8, 1).Value = "14:45"
.Cells(9, 1).Value = "16:00"
.Cells(10, 1).Value = "17:15"
.Cells(11, 1).Value = "18:15"
With Range("A2", "A11")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.ColumnWidth = 15
End With
ActiveSheet.Cells.Rows.AutoFit
Does anyone have any idea why this could be happening?
Excel stores times and dates as numbers. Each whole number is a day and hours, minutes and seconds are broken down as fractions of that day. 8:30 is just a time so there is no whole number and 8.5/24 = 0.3541667.
You can test this with this code and this may provide you a way to format your inputs. Type 8:30 into cell A1
Sub test()
Debug.Print sheet1.Range("A1").Value = "8:30" 'returns false
Debug.Print Format(sheet1.Range("A1").Value, "h:mm") = "8:30" 'returns true
Debug.Print Sheet1.Range("A1").Text = "8:30" 'return true
End Sub