Date keep changing its format

hsolanki

Board Regular
Joined
Jan 16, 2020
Messages
204
Office Version
  1. 2010
Platform
  1. Windows
Hello i have userform and textbox 14 you type a date e.g. 29/12/2020 and when it adds on to the sheet it is keep changing it to 12/29/2020. i even set the cells as short date also using the custom format change to DD/MM/YYYY however when userform adds the data its keep changing to MM/DD/YYYY

can somebody please help me.

i want to textbox 14 to add the date format only DD/MM/YYYY
 
Hi Jo sorry where do i neeed to use the DateValue or CDate in the code?
 
Upvote 0

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Hi Jo sorry where do i neeed to use the DateValue or CDate in the code?
On all the lines of code where you are writing the date from the User Form to the Worksheet, i.e.
VBA Code:
sh.Range("A" & n + 1).Value = DateValue(Me.TextBox14)
or
VBA Code:
sh.Range("A" & n + 1).Value = CDate(Me.TextBox14)
 
Upvote 0
Hi Jo Thank you however i have got problem when list box adds the value which it then changes to MM/DD/YYYY.
 
Upvote 0
Thank you however i have got problem when list box adds the value which it then changes to MM/DD/YYYY.
I suspect that is due to entering it in English format, and having Excel VBA using American format.
It is hard me to test, as I have the American version, so I cannot really recreate that situation.

Maybe try something like this?
VBA Code:
sh.Range("A" & n + 1).Value = DateValue(Mid(Me.TextBox14,4,2) & "/" & Left(Me.TextBox14,2) & "/" & Right(Me.TextBox14,4))

If that does not work, place this line above that line of code, and let me know what the Message Box returns when you run it:
VBA Code:
MsgBox Me.TextBox14
 
Upvote 0
Solution
Hi Jo entering the date it is fine now as it is DD/MM/YYYY however when i tried to search using with the dates it does not populate the data in to text box. which is in different userform. below its the code for the search criteria.
also the msgbox comes as 29/12/2020.
VBA Code:
Private Sub CommandButton1_Click()
Application.EnableCancelKey = xlDisabled
    ' Validate Dates
    Dim startDate As Date
    Dim endDate As Date
    startDate = CDate(IIf(TextBox1.Value = vbNullString, 0, TextBox1.Value))
    endDate = CDate(IIf(TextBox2.Value = vbNullString, 0, TextBox2.Value))
    If startDate = 0 Then
        MsgBox "You need to select your First Day off", vbCritical, "Beginning dates"
        Exit Sub
    End If
    
       If endDate = 0 Then
        MsgBox "You need to select your Last day off", vbCritical, "End Date"
        Exit Sub
    End If
    
    ' Validate product
    Dim productName As String
    productName = ComboBox1.Value
    If productName = vbNullString Then
        MsgBox "Please choose a Supervisor", vbCritical, "Select Supervisors"
        Exit Sub
    End If
    
    ' Prepare listbox
    Dim dataListBox As MSForms.ListBox
    Set dataListBox = Me.ListBox1
    
    With dataListBox
        .Clear
         .ColumnCount = 8
          .Top = 122
            .Font.Size = 10
            .IntegralHeight = False
        AddDataToListBox dataListBox, productName, startDate, endDate
    End With
    
    With ListBox1
       '.Height = .Height + .Font.Size + 2
        .Top = Me.ListBox1.Top + 10
       ListBox1.ColumnWidths = "70;80;80;80;80;80;85;70"
    .IntegralHeight = True
    End With
    
End Sub

Private Sub AddDataToListBox(ByVal listBoxControl As MSForms.ListBox, ByVal productName As String, ByVal startDate As Date, ByVal endDate As Date)
    ' Set a reference to the vehicles worksheet
    Dim AttendanceSheet As Worksheet
    Set AttendanceSheet = ThisWorkbook.Worksheets("Attendance")
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' Get last row
    Dim lastRow As Long
    lastRow = AttendanceSheet.Cells(AttendanceSheet.Rows.Count, "A").End(xlUp).Row
    
    ' Set range to evaluate
    Dim sourceRange As Range
    Set sourceRange = AttendanceSheet.Range("A5:A" & lastRow)
    
    ' Loop through each cell in range
    Dim sourceCell As Range
    For Each sourceCell In sourceRange.Cells
    
        ' Check if source cell is between dates
        If sourceCell.Value >= startDate And sourceCell.Value <= endDate Then
        
            ' Check if product matches
            If sourceCell.Offset(0, 7).Value = productName Then
                
                ' Begin a counter to add list items
                Dim counter As Long
                
                With listBoxControl
                Dim X, d, yuk, mak As Integer
                For X = 1 To 15
                DoEvents
                If E = 0 Then
                d = d + 9
                yuk = 70
                End If
                UserForm4.Height = yuk + d
                Next
                    .AddItem
                    .List(counter, 0) = sourceCell.Offset(0, 0).Value
                    ' You're missing one column here (is it on purpose?)
                    .List(counter, 1) = sourceCell.Offset(0, 1).Value
                    .List(counter, 2) = sourceCell.Offset(0, 2).Value
                    .List(counter, 3) = sourceCell.Offset(0, 3).Value
                    .List(counter, 4) = sourceCell.Offset(0, 4).Value
                    .List(counter, 5) = sourceCell.Offset(0, 5).Value
                    .List(counter, 6) = sourceCell.Offset(0, 6).Value
                    .List(counter, 7) = sourceCell.Offset(0, 7).Value
                    
                End With
                
                counter = counter + 1
                
            End If
        
        End If
    
    Next sourceCell
    
    If counter = 0 Then
    MsgBox "No new record found!", vbExclamation, "No Records"
    Exit Sub
    
    Else
    MsgBox Me.ListBox1.ListCount & Space(4) & "New Records Found", vbInformation, "New Records Found"
    End If
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub


Private Sub UserForm_Initialize()

Dim sh As Worksheet
Dim X, a, b As Long, c As Variant
Dim h As Variant

Set sh = Worksheets("Attendance")
Application.ScreenUpdating = False
'Unique Records
For X = 2 To Cells(Rows.Count, 8).End(xlUp).Row
If WorksheetFunction.CountIf(sh.Range("H5:H" & X), Cells(X, 8)) = 1 Then
ComboBox1.AddItem Cells(X, 8).Value
End If
Next
'Alphabetic Order
For a = 0 To ComboBox1.ListCount - 1
  For b = a To ComboBox1.ListCount - 1
        If ComboBox1.List(b) < ComboBox1.List(a) Then
c = ComboBox1.List(a)
    ComboBox1.List(a) = ComboBox1.List(b)
    ComboBox1.List(b) = c
       End If
  Next
  Next
        With ListBox2
    ListBox2.ColumnCount = 8
    ListBox2.ColumnWidths = "70;80;80;80;80;80;95;70"
    .Top = Me.ListBox1.Top - 30
    .Height = 20
    .Font.Bold = False
    .Font.Name = "Tahoma"
    .Font.Size = 8
    .List = Sheets("Attendance").Range("A3:H3").Value
    End With
  
UserForm4.Height = 150
Application.ScreenUpdating = True
End Sub
 
Upvote 0
You probably have to apply to same logic here, to TextBox1 and TextBox2.
VBA Code:
    startDate = CDate(IIf(TextBox1.Value = vbNullString, 0, TextBox1.Value))
    endDate = CDate(IIf(TextBox2.Value = vbNullString, 0, TextBox2.Value))
 
Upvote 0
Something like this instead of those two lines above:
VBA Code:
    If TextBox1.Value = vbNullString Then
        StartDate = 0
    Else
        StartDate = DateValue(Mid(TextBox1, 4, 2) & "/" & Left(TextBox1, 2) & "/" & Right(TextBox1, 4))
    End If
    
     If TextBox2.Value = vbNullString Then
        EndDate = 0
    Else
        EndDate = DateValue(Mid(TextBox2, 4, 2) & "/" & Left(TextBox2, 2) & "/" & Right(TextBox2, 4))
    End If
 
Upvote 0
Hi Joe Many thanks for all your help. nothing had worked however i just deleted the complete column A and re pasted a different cells into all of the column A and ti worked :)
 
Upvote 0
OK, glad to hear that you got the secondary question figured out also.
 
Upvote 0
I re-marked post 14 as the solution, as that one seemed to answer your original question, and the one you marked was just a comment that had no solution.
 
Upvote 0

Forum statistics

Threads
1,224,755
Messages
6,180,766
Members
452,996
Latest member
nelsonsix66

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top