<HELP>Modify calender code for a combo box

G

Guest

I have the following code on a page to pop up a calender when 1 of 2 cells
are selected and then the chosen date fills the active cell and disappears
when a cell outside the range is selected.
My question is - is it possible to modify this code to do the same with a
combo box I have on another page. I have tried substituting references to the
calender object with the combo box name but there are some obvious other
things that need changing and I am a VBA dunce. The code is

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "dd/mm/yy"
ActiveCell.Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("G14,G17"), 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
End Sub

and the current code for the combo box is

Private Sub ComboBox1_Change()

End Sub

Can anyone help
gratitude in vast quantities in advance
 
R

Ron de Bruin

Hi Mark

Try it with this
The name of the combobox = ComboBox1


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

Private Sub ComboBox1_Click()
Calendar1.Left = Me.ComboBox1.Left + Me.ComboBox1.Width - Calendar1.Width
Calendar1.Top = Me.ComboBox1.Top + Me.ComboBox1.Height
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Calendar1.Visible Then Calendar1.Visible = False
End Sub
 
G

Guest

Hi Ron
Thanks for your reply.
You obviously recognise this code. I think its great and was just what I was
looking for to add into the spreadsheet I'm working on.
I noticed in the amended code you posted that the calender object is still
referenced
does that mean I will still be choosing a date to fill the active cell?
What I was trying to do was pop up my combo box, select an entry from the
named list it uses and have that data fill the active cell. The type of thing
I'm not sure what to change is the line

Calendar1.Value = Date

what would this be for a combo box?

do you have any suggestions.

TiA

Mark
 
R

Ron de Bruin

I have misunderstood you I believe
You not want to use the Calendar control here

What I was trying to do was pop up my combo box, select an entry from the
named list it uses and have that data fill the active cell.

If you use a combobox from the Controltoolbox in your worksheet ?
when you are in Design mode double clock on the combobox

And add this to the sheet module

Private Sub ComboBox1_Change()
ActiveCell.Value = Me.ComboBox1.Value
End Sub
 
G

Guest

Ive just had a thought would the line read somrthing like-

Combo1.Value = 'name of my list'

So, would this work?

Private Sub Combo1_Click()
ActiveCell.Value = Combo1.Value
ActiveCell.NumberFormat = "Text"
ActiveCell.Select
End Sub

Private Sub ComboBox1_Click()
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("D19:D36"), Target) Is Nothing Then
Combo1.Left = Me.ComboBox1.Left + Me.ComboBox1.Width - Combo1.Width
Combo1.Top = Me.ComboBox1.Top + Me.ComboBox1.Height
Combo1.Visible = True
' Make your Selection
Combo1.Value = "Contracts"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Combo1.Visible Then Combo1.Visible = False
End Sub

Could you advise please
TiA
 
G

Guest

Hi Ron

I've got this working - my first sucess

I would like your help on one more thing please.

I would like to repeat the code on the same page but when I copy and paste
it and change the name of the combo box I wish to reference I get an
'ambiguous name' error pointing to

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

What would I need to change on the repeated code to stop this error?

The whole code is-

Private Sub DaysCombo_Click()
ActiveCell.Value = DaysCombo.Value
ActiveCell.NumberFormat = "Text"
ActiveCell.Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("A2:A20"), Target) Is Nothing Then
DaysCombo.Left = Target.Left + Target.Width - DaysCombo.Width
DaysCombo.Top = Target.Top + Target.Height
DaysCombo.Visible = True
' Make your Selection
DaysCombo.Value = "Days"
ElseIf DaysCombo.Visible Then DaysCombo.Visible = False
End If
End Sub

I want to use a combo box called DatesCombo in B2:B20
a combo box called MonthsCombo in C2:C20
a comb0 box called YearCombo in D2:D20

I am putting together a test workbook to select the following in the first
four colomns

A - Days Mon - Fri
B - Date 1st - 31st
C - Month Jan - Dec
D - Year 2000 - 2010

I want to use a similar structure in the project I am working on. If I get
the test sheet working would you be interested in a copy for your site as it
is your code I've modified.

TiA
Regards
Mark
 
R

Ron de Bruin

Hi Mark

Why don't you use Data Validation for this
Much easier
http://www.contextures.com/xlDataVal01.html


With code you can do this

Private Sub DaysCombo_Click()
ActiveCell.Value = DaysCombo.Value
ActiveCell.NumberFormat = "@"
ActiveCell.Activate
End Sub

Private Sub DatesCombo_Click()
ActiveCell.Value = DatesCombo.Value
ActiveCell.NumberFormat = "@"
ActiveCell.Activate
End Sub

Private Sub MonthsCombo_Click()
ActiveCell.Value = MonthsCombo.Value
ActiveCell.NumberFormat = "@"
ActiveCell.Activate
End Sub

Private Sub YearCombo_Click()
ActiveCell.Value = YearCombo.Value
ActiveCell.NumberFormat = "@"
ActiveCell.Activate
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub

If Not Application.Intersect(Range("A2:A20"), Target) Is Nothing Then
DaysCombo.Left = Target.Left + Target.Width - DaysCombo.Width
DaysCombo.Top = Target.Top + Target.Height
DaysCombo.Visible = True
' Make your Selection
'DaysCombo.Value = "1"
ElseIf DaysCombo.Visible Then DaysCombo.Visible = False
End If

If Not Application.Intersect(Range("B2:B20"), Target) Is Nothing Then
DatesCombo.Left = Target.Left + Target.Width - DatesCombo.Width
DatesCombo.Top = Target.Top + Target.Height
DatesCombo.Visible = True
' Make your Selection
'DatesCombo.Value = "10"
ElseIf DatesCombo.Visible Then DatesCombo.Visible = False
End If

If Not Application.Intersect(Range("C2:C20"), Target) Is Nothing Then
MonthsCombo.Left = Target.Left + Target.Width - MonthsCombo.Width
MonthsCombo.Top = Target.Top + Target.Height
MonthsCombo.Visible = True
' Make your Selection
'MonthsCombo.Value = "100"
ElseIf MonthsCombo.Visible Then MonthsCombo.Visible = False
End If

If Not Application.Intersect(Range("D2:D20"), Target) Is Nothing Then
YearCombo.Left = Target.Left + Target.Width - YearCombo.Width
YearCombo.Top = Target.Top + Target.Height
YearCombo.Visible = True
' Make your Selection
'YearCombo.Value = "1000"
ElseIf YearCombo.Visible Then YearCombo.Visible = False
End If

End Sub
 
G

Guest

Hi Ron
Thanks for the code, I'll try it later and let you know how it goes.

There's a couple of reasons I don't want to use DV, my lists are quite long
and the area the user needs to view is quite large (needs to be viewed at 75%
to see all relavant field on one page) so combo boxes, with their editable
font, row numbers seem and autofill properties are a better option.

Once again thanks for all your help.

Mark
 
G

Guest

Ron
Sorry its been a while, got side tracked.
Anyway your code worked a treat and the project is coming along nicely now.

I just like to say a big thanks for all your help. I'm a relative novice to
excel and have been on a steep learning curve over the last ten days or so
and as far as VB goes the learning curve has been vertical, so its great to
have the support of people like yourself the advance the knowledge of people
like me, and all for free.

YOUR ALL TOP BLOKES

by the way the final code looks like this

Private Sub ComboBox1_Click()
ActiveCell.Value = ComboBox1.Value
ActiveCell.Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("F9:F36"), Target) Is Nothing Then
ComboBox1.Left = Target.Left
ComboBox1.Top = Target.Top
ComboBox1.Visible = True
' Make your Selection
ComboBox1.Value = ""
ElseIf ComboBox1.Visible Then ComboBox1.Visible = False
End If
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top