Date picker calendars & combo box code questions.

dhm · Feb 11, 2013

Hi all,

I’ll try and keep it succinct & thanks in advance to any responses.

The following code I have cobbled together (and indeed it truly looks like it!) from various sources and by sheer luck more than judgement it works, however it is not without some niggles.

Currently there are five items that are using the code

3 date picker calendars
2 combo boxes using validation lists

Issues that I would be most grateful for help on are:

When I reopen the file and select any of the three cells that have the calendar/dates option the drop down box fills the entire screen instead of showing just the date and the drop down arrow to select a date from the calendar. If I go into the developer tab and perhaps select design mode or go into the visual basic screen and randomly move around the screen, upon return to the spread sheet the calendar cells revert back to behaving as I’d expect!? The sizes in the properties do not change and the file is enabled for macros. A way to create consistency when the file is opened so that selecting the calendar cell does not cause general user panic would be great.

There are two combo boxes currently, however this could increase to double figures (form for users to fill in and this is hopefully making it easier for them and more accurate info upon return using the validation lists etc), the first one worked OK however when typing in the combo box it shrank to show only the letters being typed (a feature now lost since the addition of the second combo box, as is the larger font size that had been applied in the properties). When the data is selected in the list it also requires a double click to ‘exit’ the combo box which is not particularly user friendly and may cause non-technical users concern. 

If an example can be posted of how the calendars & two combo boxes should look in terms of code to alleviate the above issues I’m sure I could add in others successfully and that would be a massive help.

Thanks again and I look forward to seeing how this works out

Regards

DHM 

CODE…..

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Workbooks.Add
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub

Private Sub ROOMCOMBO_Change()

End Sub

'==========================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets("ValidationLists")

Cancel = True
Set cboTemp = ws.OLEObjects("roomcombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 55
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.ROOMCOMBO.DropDown

End If

errHandler:
Application.EnableEvents = True
Exit Sub

Cancel = True
Set cboTemp = ws.OLEObjects("areacombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 55
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.areacombo.DropDown

End If

End Sub

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Select
Calendar1.Visible = False

End Sub

Private Sub Calendar2_Click()
ActiveCell.Value = CDbl(Calendar2.Value)
ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Select
Calendar2.Visible = False

End Sub

Private Sub Calendar3_Click()
ActiveCell.Value = CDbl(Calendar3.Value)
ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Select
Calendar3.Visible = False

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("J8"), Target) Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("J10"), Target) Is Nothing Then
Calendar2.Left = Target.Left + Target.Width - Calendar2.Width
Calendar2.Top = Target.Top + Target.Height
Calendar2.Visible = True
' select Today's date in the Calendar
Calendar2.Value = Date
ElseIf Calendar2.Visible Then Calendar2.Visible = False
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("J12"), Target) Is Nothing Then
Calendar3.Left = Target.Left + Target.Width - Calendar3.Width
Calendar3.Top = Target.Top + Target.Height
Calendar3.Visible = True
' select Today's date in the Calendar
Calendar3.Value = Date
ElseIf Calendar3.Visible Then Calendar3.Visible = False
End If

Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Application.EnableEvents = False
Application.ScreenUpdating = True

If Application.CutCopyMode Then
'allow copying and pasting on the worksheet
GoTo errHandler
End If

Set cboTemp = ws.OLEObjects("areacombo")
On Error Resume Next
With cboTemp
.Top = 10
.Left = 10
.Width = 50
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With

errHandler:
Application.EnableEvents = True
Exit Sub

End Sub

Date picker calendars & combo box code questions.

dhm

New Member

Excel Facts

Similar threads

Forum statistics

Share this page

Date picker calendars & combo box code questions.

dhm

New Member

Excel Facts

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock