Date shown is different to its code format

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
Evening,

I would like the date to populate TextBox1.

I have used 2 different codes as shown here but both show mm/dd/yyyy and not dd/mm/yyyy

Code:
TextBox1.Value = Date

Code:
[COLOR=#333333]TextBox1.Value = Now
[/COLOR][COLOR=#333333]TextBox1 = Format(TextBox1.Value, "dd/mm/yyyy")[/COLOR]


Here is the code in use.

Code:
Private Sub UserForm_Initialize()'Modified  10/3/2018  5:51:42 AM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
lastrow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
Dim Lastrowa As Long
Sheets("POSTAGE").Cells(8, 2).Resize(lastrow - 7).Copy Sheets("POSTAGE").Cells(1, 12)
Lastrowa = Sheets("POSTAGE").Cells(Rows.Count, "L").End(xlUp).Row
Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Sort key1:=Cells(1, 12).Resize(Lastrowa), order1:=xlAscending, Header:=xlNo
CustomerSearchBox.List = Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Value
Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Clear
Application.ScreenUpdating = True




TextBox1.Value = Date
TextBox2.SetFocus
End Sub
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
You asked for Date

You did not specify formatting
Try this:

TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
 
Upvote 0
Hi,
Just noticed something.

When i open the userform TextBox1 shows the date correctly i,e 04/10/2018
I complete the form & press the Transfer button.
I have noticed that the date in column A cell is shown like so 10/04/2018

Code below shows user form including transfer button code "command button1"

USERFORM
Code:
Private Sub CommandButton1_Click()Cancel = 0
If TextBox2.Text = "" Then
    Cancel = 1
    MsgBox "Customer`s Name Not Entered", vbCritical
    TextBox2.SetFocus
ElseIf TextBox3.Text = "" Then
    Cancel = 1
    MsgBox "Item Description Not Entered", vbCritical
    TextBox3.SetFocus
ElseIf TextBox4.Text = "" Then
    Cancel = 1
    MsgBox "Tracking Number Not Entered", vbCritical
    TextBox4.SetFocus
ElseIf TextBox5.Text = "" Then
    Cancel = 1
    MsgBox "Username Not Entered", vbCritical
    TextBox5.SetFocus
    
ElseIf OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Origin", vbCritical
    
ElseIf OptionButton4.Value = False And OptionButton5.Value = False And OptionButton6.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Ebay Account", vbCritical
    
End If


If Cancel = 1 Then
        Exit Sub
End If


Dim i As Long
Dim x As Long
Dim ctrl As Control
Dim Lastrow As Long
Lastrow = ThisWorkbook.Worksheets("POSTAGE").Cells(Rows.Count, 1).End(xlUp).Row
    


    
 With ThisWorkbook.Worksheets("POSTAGE")
    .Cells(Lastrow + 1, 1).Value = TextBox1.Text: TextBox1.Value = ""
    .Cells(Lastrow + 1, 2).Value = TextBox2.Text: TextBox2.Value = ""
    .Cells(Lastrow + 1, 3).Value = TextBox3.Text: TextBox3.Value = ""
    .Cells(Lastrow + 1, 5).Value = TextBox4.Text: TextBox4.Value = ""
    .Cells(Lastrow + 1, 9).Value = TextBox5.Text: TextBox5.Value = ""
    .Cells(Lastrow + 1, 4).Value = TextBox6.Text: TextBox6.Value = ""
    If OptionButton1.Value = True Then .Cells(Lastrow + 1, 8).Value = "DR": OptionButton1.Value = False
    If OptionButton2.Value = True Then .Cells(Lastrow + 1, 8).Value = "IVY": OptionButton2.Value = False
    If OptionButton3.Value = True Then .Cells(Lastrow + 1, 8).Value = "N/A": OptionButton3.Value = False
    If OptionButton4.Value = True Then .Cells(Lastrow + 1, 6).Value = "EBAY": OptionButton4.Value = False
    If OptionButton5.Value = True Then .Cells(Lastrow + 1, 6).Value = "WEB SITE": OptionButton5.Value = False
    If OptionButton6.Value = True Then .Cells(Lastrow + 1, 6).Value = "N/A": OptionButton6.Value = False
End With
TextBox2.SetFocus
TextBox1.Value = Now
TextBox1 = Format(TextBox1.Value, "dd/mm/yyyy")
End Sub
Private Sub CommandButton2_Click()
Unload PostageTransferSheet


End Sub


Private Sub CommandButton3_Click()
CustomerSearchBox.BackColor = vbRed
End Sub


Private Sub DHL_Click()
ActiveWorkbook.FollowHyperlink Address:="http://www.dhl.co.uk/en/express/tracking.html", NewWindow:=True


End Sub
Private Sub HERMES_Click()
ActiveWorkbook.FollowHyperlink Address:="https://www.myhermes.co.uk/tracking-results.html", NewWindow:=True


End Sub
Private Sub LABEL_Click()
TrackingLabel.Show


End Sub
Private Sub ROYALMAIL_Click()
ActiveWorkbook.FollowHyperlink Address:="https://www.royalmail.com/track-your-item", NewWindow:=True


End Sub


Private Sub TextBox1_Change()
    TextBox1 = UCase(TextBox1)
End Sub
Private Sub TextBox2_Change()
    TextBox2 = UCase(TextBox2)
End Sub
Private Sub TextBox3_Change()
    TextBox3 = UCase(TextBox3)
End Sub
Private Sub TextBox4_Change()
    TextBox4 = UCase(TextBox4)
End Sub
Private Sub TextBox5_Change()
    TextBox5 = UCase(TextBox5)
End Sub
Private Sub TextBox6_Change()
    TextBox6 = UCase(TextBox6)
End Sub
Private Sub CustomerSearchBox_Change()
'Modified  10/3/2018  5:51:42 AM  EDT
Dim SearchString As String
Dim SearchRange As Range
SearchString = CustomerSearchBox.Value
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "B").End(xlUp).Row
Set SearchRange = Range("B2:B" & Lastrow).Find(SearchString, LookIn:=xlValues, LookAt:=xlWhole)
If SearchRange Is Nothing Then MsgBox SearchString & "  Not Found": Exit Sub
SearchRange.Select
Unload Me
End Sub
Private Sub UserForm_Initialize()
'Modified  10/3/2018  5:51:42 AM  EDT
Application.ScreenUpdating = False
Dim Lastrow As Long
Lastrow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
Dim Lastrowa As Long
Sheets("POSTAGE").Cells(8, 2).Resize(Lastrow - 7).Copy Sheets("POSTAGE").Cells(1, 12)
Lastrowa = Sheets("POSTAGE").Cells(Rows.Count, "L").End(xlUp).Row
Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Sort key1:=Cells(1, 12).Resize(Lastrowa), order1:=xlAscending, Header:=xlNo
CustomerSearchBox.List = Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Value
Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Clear
Application.ScreenUpdating = True


TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox2.SetFocus
End Sub
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim fndRng As Range


If Me.TextBox2.Value = "" Then Exit Sub


With Sheets("POSTAGE").Range("B:B")
    Set fndRng = .Find(What:=Me.TextBox2.Value, LookIn:=xlValues, LookAt:=xlWhole, _
                   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
End With
                   
If Not fndRng Is Nothing Then
    'name was found
    MsgBox Me.TextBox2.Value & " was found at  " & fndRng.Address(False, False), vbCritical, "DUPLICATE ENTRY"
    'clear the text box
    Me.TextBox2.Value = ""
    'cancel moving out of textbox
    Cancel = True
End If
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,950
Messages
6,122,438
Members
449,083
Latest member
Ava19

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