Add Calendar Multiple Times To Excel

Paul Wagner
Paul Wagner used Ask the Experts™
on
I need to add today's date drop down in about 100 cells. Each cell needs to be separate from all the others (no linking the same date).

I have added the Microsoft Date and Time Picker via Developer Options once and linked it to a cell, but can't cut and paste it to other cells... So, that means I have to manually add each calendar and manually edit the cell linkage? That would take a very long time.

Is there a way to add multiple calendars and have Excel 'auto-adjust' the calendar to each cell?

Or maybe I need to ask it this way:
How can I quickly add a date selection drop down to over 100 cells at one time?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Older than dirt
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
Please see my Magical floating ActiveX control article. It will describe exactly how to do what you want.
Roy CoxGroup Finance Manager

Commented:
Tsake a look at my examples here. They do not use ActiveX controls so will work on any users computer without the problems associated with ActiveX controls that may not be present on all machines.
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Here's a working example. It is currently set up to show the date picker in cells A1, B5 and C2 via this line
Set rngDP = Union(Range("A1"), Range("B5"), Range("C2"))

Open in new window

and that can easily be changed to include any number of contiguous and/or non-contiguous cells.
28926462.xlsm
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Paul WagnerPrincipal Consultant

Author

Commented:
@Martin Liss
I have your xlsm file open and am reading your article. Where do I enter/copy the code to have it be in the other empty cells so the calendar is there?
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Please see the workbook I posted in post ID: 41466693
Paul WagnerPrincipal Consultant

Author

Commented:
OK. How do I search by post ID?
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
download
Roy CoxGroup Finance Manager

Commented:
pAUL

hAVE YOU LOOKED AT MY ADDIN? tHE OTHER EXAMPLES HAVE FULLY WORKING EXAMPLES WITH THE CODE TO SHOW THE CALENDAR ON A SHEET OR EVEN A uSERfORM
Paul WagnerPrincipal Consultant

Author

Commented:
(Gotcha. I was looking for another article.)

So, I changed the range in your xlsm document and that worked fine, allowing me to mass add several calendars.

I then copied and pasted your VB code from your worksheet to mine and got these errors.
2.PNG
3.PNG
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
In my article I mention that you need to manually add one control to the sheet. So if you haven't already done so, add a datepicker to the sheet where you want to use it.
Paul WagnerPrincipal Consultant

Author

Commented:
After manually adding a date picker to the sheet, I get this error and the word Union is highlighted:

error 2
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Union is meant join together two or more sub-ranges and you only indicated one range. If in fact that is the only range you want to use then replace your Worksheet_SelectionChange code with this version.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim ws As Worksheet
'Dim rngDP As Range
Set ws = ActiveSheet

On Error Resume Next
grngCurrent.Value = DTPicker1.Value

' Set the range where you want the date picker to appear
'Set rngDP = Union(Range("A1"), Range("B5"), Range("C2"))
'If Intersect(ActiveCell, Range(rngDP.Address)) Is Nothing Then
If Intersect(ActiveCell, Range("D13:D34")) Is Nothing Then
    DTPicker1.Visible = False
    Exit Sub
End If

Set grngCurrent = ActiveCell

Application.EnableEvents = False
Application.ScreenUpdating = False

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

With DTPicker1
    .Font.Size = 8
    .Visible = True
    .Left = Target.Left + 1
    .Top = Target.Top + 1
    If Target.Width >= 65 Then
        .Width = Target.Width - 1
    Else
        .Width = 65
    End If
    .Height = Target.Height - 1
    .Text = Target.Value
    .Activate
End With

errHandler:
  Application.ScreenUpdating = True
  Application.EnableEvents = True

End Sub

Open in new window

Paul WagnerPrincipal Consultant

Author

Commented:
OK, I fixed it. I changed the code to this:

Set rngDP = Range("D13:D34")

That did the trick. Every cell now has a calendar in it!
Now, I'll expand that range to the entire column and see how it goes.
Thanks for the help.
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
While that apparently worked for you, please see the code in my last post for a different way to do it that doesn't need rngDP. (See line 13)
Paul WagnerPrincipal Consultant

Author

Commented:
Got it. Now, how do I delete it if I want to clear the cell?
Paul WagnerPrincipal Consultant

Author

Commented:
I'll give you an A since you worked back and forth with me (which I greatly appreciate), but you might consider improving your article. As I am not a VB or Excel guru, I was completely lost when reading your instructions. If you can receive this, I recommend screenshots in numbered order with brief instructions for each step. Yes, it will take some more work, but you will get less follow-up questions. Food for thought. Thanks again for your help!
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
You're welcome and I'm glad I was able to help and I will consider your advice.

In my profile you'll find links to some other articles I've written that may interest you.

Marty - MVP 2009 to 2015
              Experts Exchange MVE 2015
              Experts-Exchange Top Expert Visual Basic Classic 2012 to 2015

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial