Date Picker Issue

C

Conell8383

Board Regular
Joined
Jul 26, 2016
Messages
66
Hi all. I hope you can help. I have a date picker that pops up on column H as I wanted to standardize how dates were entered on the the Excel sheet. The issue I am facing is that if I or any of my team based in Dublin click on a cell in column H from Cell H10 down then the date picker pops up and it records the date as i want 05/11/2017 or "mm/dd/yyyy"

Now if my team mates in other countries like Denmark or Finland click on a cell below H10 the date format is returned .5.11.17 it is not returning the 05/11/2017 format

In screen shot 1 you can see a visual representation of my issue.

My Code is below Can any one solve this issue?

As always any and all help is greatly appreciated

Screen Shot 2 shows the Calendar form is in a module all to its self.

CODE
Code: 
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     'check cells for desired format to trigger the calendarfrm.show routine
     'otherwise exit the sub
    Dim DateFormats, DF
    DateFormats = Array("m/d/yy;@", "mm/dd/yyyy")
    For Each DF In DateFormats
        If DF = Target.NumberFormat Then
            If CalendarFrm.HelpLabel.Caption <> "" Then
                CalendarFrm.Height = 191 + CalendarFrm.HelpLabel.Height
            Else: CalendarFrm.Height = 191
                CalendarFrm.Show
            End If
        End If
    Next
End Sub

screen shot 1

XKONJtr.png


Screen Shot 2
UbHuG0M.png
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
I cannot tell for sure, but it seems like you are trying to format the dates with the VB code and then put that into the cell. I am guessing that because you have Column H cells formatted as Text. As I recall, the DatePicker control has a Date property... change the Column H format to General and then have your DatePicker code put the DatePicker's Date property into the cell and then have your code change the cell's NumberFormat to the date format you want.
 
Upvote 0
Hi Rick. thank you for taking the time to respond. If i change the format of column H to General then the Date Picker will simply not appear. Thank you for the suggestion though but alas it has not solved the issue.
 
Upvote 0
Conell8383 said:
If i change the format of column H to General then the Date Picker will simply not appear.
Click to expand...
That should not be controlled by the format of the cells... show us the code procedure which you use to display the Date Picker control.
 
Last edited:
Upvote 0
Hi Rick the code for the Calendar is below

Code: 
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CalendarFrm 
   Caption         =   "Calendar Control"
   ClientHeight    =   3690
   ClientLeft      =   45
   ClientTop       =   360
   ClientWidth     =   3960
   OleObjectBlob   =   "CalendarFrm.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "CalendarFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False






Option Explicit
    Dim ThisDay As Date
    Dim ThisYear, ThisMth As Date
    Dim CreateCal As Boolean
    Dim i As Integer
Private Sub UserForm_Initialize()
    Application.EnableEvents = False
    'starts the form on todays date
    ThisDay = Date
    ThisMth = Format(ThisDay, "mm")
    ThisYear = Format(ThisDay, "yyyy")
    For i = 1 To 12
        CB_Mth.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm")
    Next
    CB_Mth.ListIndex = Format(Date, "mm") - Format(Date, "mm")
    For i = -20 To 50
        If i = 1 Then CB_Yr.AddItem Format((ThisDay), "yyyy") Else CB_Yr.AddItem _
            Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy")
    Next
    CB_Yr.ListIndex = 21
    'Builds the calendar with todays date
    CalendarFrm.Width = CalendarFrm.Width
    CreateCal = True
    Call Build_Calendar
    Application.EnableEvents = True
End Sub
Private Sub CB_Mth_Change()
    'rebuilds the calendar when the month is changed by the user
    Build_Calendar
End Sub
Private Sub CB_Yr_Change()
    'rebuilds the calendar when the year is changed by the user
    Build_Calendar
End Sub
Private Sub Build_Calendar()
    'the routine that actually builds the calendar each time
    If CreateCal = True Then
    CalendarFrm.Caption = " " & CB_Mth.Value & " " & CB_Yr.Value
    'sets the focus for the todays date button
    CommandButton1.SetFocus
    For i = 1 To 42
        If i < Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
            Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
                ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
            Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
                ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy")
        ElseIf i >= Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
            Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) _
                & "/1/" & (CB_Yr.Value))), ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
            Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
                ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy")
        End If
        If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
        ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "mmmm") = ((CB_Mth.Value)) Then
            If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H80000018  '&H80000010
            Controls("D" & (i)).Font.Bold = True
        If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
            ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") = Format(ThisDay, "m/d/yy") Then Controls("D" & (i)).SetFocus
        Else
            If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H8000000F
            Controls("D" & (i)).Font.Bold = False
        End If
    Next
    End If
End Sub
Private Sub D1_Click()
    'this sub and the ones following represent the buttons for days on the form
    'retrieves the current value of the individual controltiptext and
    'places it in the active cell
    ActiveCell.Value = D1.ControlTipText
    Unload Me
    'after unload you can call a different userform to continue data entry
    'uncomment this line and add a userform named UserForm2
    'Userform2.Show
    
End Sub
Private Sub D2_Click()
    ActiveCell.Value = D2.ControlTipText
    Unload Me
    
End Sub
Private Sub D3_Click()
    ActiveCell.Value = D3.ControlTipText
    Unload Me
    
End Sub
Private Sub D4_Click()
    ActiveCell.Value = D4.ControlTipText
    Unload Me
    
End Sub
Private Sub D5_Click()
    ActiveCell.Value = D5.ControlTipText
    Unload Me
    
End Sub
Private Sub D6_Click()
    ActiveCell.Value = D6.ControlTipText
    Unload Me
    
End Sub
Private Sub D7_Click()
    ActiveCell.Value = D7.ControlTipText
    Unload Me
    
End Sub
Private Sub D8_Click()
    ActiveCell.Value = D8.ControlTipText
    Unload Me
    
End Sub
Private Sub D9_Click()
    ActiveCell.Value = D9.ControlTipText
    Unload Me
    
End Sub
Private Sub D10_Click()
    ActiveCell.Value = D10.ControlTipText
    Unload Me
    
End Sub
Private Sub D11_Click()
    ActiveCell.Value = D11.ControlTipText
    Unload Me
    
End Sub
Private Sub D12_Click()
    ActiveCell.Value = D12.ControlTipText
    Unload Me
    
End Sub
Private Sub D13_Click()
    ActiveCell.Value = D13.ControlTipText
    Unload Me
    
End Sub
Private Sub D14_Click()
    ActiveCell.Value = D14.ControlTipText
    Unload Me
    
End Sub
Private Sub D15_Click()
    ActiveCell.Value = D15.ControlTipText
    Unload Me
    
End Sub
Private Sub D16_Click()
    ActiveCell.Value = D16.ControlTipText
    Unload Me
    
End Sub
Private Sub D17_Click()
    ActiveCell.Value = D17.ControlTipText
    Unload Me
    
End Sub
Private Sub D18_Click()
    ActiveCell.Value = D18.ControlTipText
    Unload Me
    
End Sub
Private Sub D19_Click()
    ActiveCell.Value = D19.ControlTipText
    Unload Me
    
End Sub
Private Sub D20_Click()
    ActiveCell.Value = D20.ControlTipText
    Unload Me
    
End Sub
Private Sub D21_Click()
    ActiveCell.Value = D21.ControlTipText
    Unload Me
    
End Sub
Private Sub D22_Click()
    ActiveCell.Value = D22.ControlTipText
    Unload Me
    
End Sub
Private Sub D23_Click()
    ActiveCell.Value = D23.ControlTipText
    Unload Me
    
End Sub
Private Sub D24_Click()
    ActiveCell.Value = D24.ControlTipText
    Unload Me
    
End Sub
Private Sub D25_Click()
    ActiveCell.Value = D25.ControlTipText
    Unload Me
    
End Sub
Private Sub D26_Click()
    ActiveCell.Value = D26.ControlTipText
    Unload Me
    
End Sub
Private Sub D27_Click()
    ActiveCell.Value = D27.ControlTipText
    Unload Me
    
End Sub
Private Sub D28_Click()
    ActiveCell.Value = D28.ControlTipText
    Unload Me
    
End Sub
Private Sub D29_Click()
    ActiveCell.Value = D29.ControlTipText
    Unload Me
    
End Sub
Private Sub D30_Click()
    ActiveCell.Value = D30.ControlTipText
    Unload Me
    
End Sub
Private Sub D31_Click()
    ActiveCell.Value = D31.ControlTipText
    Unload Me
    
End Sub
Private Sub D32_Click()
    ActiveCell.Value = D32.ControlTipText
    Unload Me
    
End Sub
Private Sub D33_Click()
    ActiveCell.Value = D33.ControlTipText
    Unload Me
    
End Sub
Private Sub D34_Click()
    ActiveCell.Value = D34.ControlTipText
    Unload Me
    
End Sub
Private Sub D35_Click()
    ActiveCell.Value = D35.ControlTipText
    Unload Me
    
End Sub
Private Sub D36_Click()
    ActiveCell.Value = D36.ControlTipText
    Unload Me
    
End Sub
Private Sub D37_Click()
    ActiveCell.Value = D37.ControlTipText
    Unload Me
    
End Sub
Private Sub D38_Click()
    ActiveCell.Value = D38.ControlTipText
    Unload Me
    
End Sub
Private Sub D39_Click()
    ActiveCell.Value = D39.ControlTipText
    Unload Me
    
End Sub
Private Sub D40_Click()
    ActiveCell.Value = D40.ControlTipText
    Unload Me
    
End Sub
Private Sub D41_Click()
    ActiveCell.Value = D41.ControlTipText
    Unload Me
    
End Sub
Private Sub D42_Click()
    ActiveCell.Value = D42.ControlTipText
    Unload Me
    
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
History of Dates to be traced in Excel (2010) in DD/MM/YYYY format
2
Replies
11
Views
354
MARK858
MARK858
W
  • Solved
Dates - issue with trying to sort
Replies
4
Views
187
Alex Blakenburg
A
M
  • Question
Excel VBA Save PDF within workbook folder and send as email attachment
Replies
1
Views
200
rpaulson
rpaulson
X
  • Solved
Color matching date through VBA
Replies
5
Views
392
xsmurf
X
T
  • Question
Macro to download SAP report to Excel
Replies
0
Views
2K
texasguy66
T

Forum statistics

Threads
1,214,537
Messages
6,120,096
Members
448,944
Latest member
SarahSomethingExcel100

Share this page

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