Date shown is different to its code format

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
2,820
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
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,272
You asked for Date

You did not specify formatting
Try this:

TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
2,820
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
 

Forum statistics

Threads
1,081,706
Messages
5,360,763
Members
400,595
Latest member
T_Dubs

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top