Calendar inhance

[Jaemun]

Anyone please help,

How to create a calendar using userform. I mean when user click on the
prefered date, it automatically display into a cell e.g. user click on 1,2,4
and 7 in the month of December, 2005 then click ok, the output display in
sheet1 cell (d5) as 1,2,4 and 7 Dec, 2005,

Thanks in advance.
Jaemun.

 

[davidmal]

Hi Jaemun,
- First you need to create a Userform.

- Right click on the toolbox and select "Additional Controls..."

- Check the box next to Calendar Control 9.0 and click OK. This will add a
calendar control to your toolbox.

- Place a Calendar control in the userform and size it how you want..

- Double click on the userform to bring up the code widow. In the top left
dropdown box select Calendar1. In the right dropdown select DblClick
- In the code window enter:
Private Sub Calendar1_DblClick()
ActiveSheet.Range("D5").Value = Calendar1.Value
End Sub

- You will need to create a command button on the sheet to open the userform.
In that sheet's code enter:
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub

Hope that helps. PS if you find the MSCAL.HLP file on your hard drive it will
give you more info on customizing the calendar.

 

[Jaemun]

Hi Davidmal,

I've done this kind of method before, What I'm looking for right now is how
enable multi select on calendar e.g. when I click the calender on date 1,2,4
and 7 in the month of December, 2005 then click OK, I want the output will
display in sheet1 cell (d5) as "1,2,4 and 7 Dec, 2005".

Any hope, this could be done?

Jaemun.

 

[Shailesh Shah]

Try this,

Put below code to userform's codemodule having calendar control.

From the click event of calendar, dates were stored to the collection
and from the click event of the commandbutton1, all the dates were
written in activecell as per your format.


------------------------------------------------
Dim datecol As New Collection

Private Sub Calendar1_Click()
On Error Resume Next

'add dates to collection
datecol.Add Calendar1.Value, CStr(Calendar1.Value)

'Hide Month & Year Selector
Calendar1.ShowDateSelectors = False

End Sub

Private Sub CommandButton1_Click()
Dim msg

' if no dates selected then exit sub
If datecol.Count = 0 Then Exit Sub

For i = 1 To datecol.Count - 1
If i = 1 Then
msg = Day(datecol(i))
Else
msg = msg & ", " & Day(datecol(i))
End If
Next

If i = 1 Then
ActiveCell.Value = Format(datecol(i), "D MMM, YYYY")
Else
ActiveCell.Value = msg & " and " & Format(datecol(i), "D MMM,
YYYY")
End If

End Sub

----------------------------------------------------------


With this the user can't change the month or year after cliking on the
date first time.

Regards,
Shah Shailesh
http://members.lycos.co.uk/shahweb/
http://in.geocities.com/shahshaileshs/
(Excel Add-ins Page)

 

[Jaemun]

Hi Shailesh Shah,

You've saved my day and I still need your help.

1. I want the selections also applicable for the date with different month
as well e.g. "28, 29 and 31 December 2005 and 2, 3 and 4 January, 2006"
(perhaps someone have any suggestions for the best format here).

2. As this is a matter of date, so, no matter which date user click first
and next, the cell value must "display the selected date" in proper
directions. E.g. 2,3,4 and not 3,2,4 etc. If you can make it out, I would
be greatfull for that.

After all, I really appreciate and valued your help.

Jaemun.

 

[Shailesh Shah]

Hi Jaemun,

1. I want the selections also applicable for the date with different

month
as well e.g. "28, 29 and 31 December 2005 and 2, 3 and 4 January, 2006"
(perhaps someone have any suggestions for the best format here).

2. As this is a matter of date, so, no matter which date user click

first
and next, the cell value must "display the selected date" in proper
directions. E.g. 2,3,4 and not 3,2,4 etc. If you can make it out, I
would
be greatfull for that.



Try below codes:

1. Now selections is also applicable for the date with different
month\year.

e.g. "28, 29 and 31 December, 2005 and 2, 3 and 4 January, 2006"

2. Dates were sorted.























Regards,
Shah Shailesh
http://members.lycos.co.uk/shahweb/
http://in.geocities.com/shahshaileshs/
(Excel Add-ins Page)

 

[Jaemun]

Hi Shailesh Shah,

Could you please try post your reply again? I think we've missed your code
here.

Jaemun.

 

[Shailesh Shah]

Hi Jaemun,

Try this,
-----------------------------------------------------------
Dim DateCol As New Collection

Dim i As Long, CurMY As Long, NxtMY As Long, PrvMY As Long

Private Sub Calendar1_Click()

On Error Resume Next

'add dates to collection
DateCol.Add Format(Calendar1.Value, "#"), Format(Calendar1.Value, "#")

End Sub

Private Sub CommandButton1_Click()

Dim ResultDate, FullDateFmt, DayFmt

'if no dates selected then exit sub
If DateCol.Count = 0 Then Exit Sub

SortDate

FullDateFmt = Format(DateCol(1), "D MMM, YYYY")

For i = 1 To DateCol.Count - 1

FullDateFmt = Format(DateCol(i), "D MMM, YYYY")

DayFmt = Day(DateCol(i))

If i = 1 Then

If DateCol.Count > 1 Then

If SameMonthYear Then

ResultDate = DayFmt

Else

ResultDate = FullDateFmt

End If

End If

Else

If SameMonthYear Then

ResultDate = IIf(SameMonthYear1, ResultDate & ", " & DayFmt, ResultDate
& " and " & DayFmt)

Else

ResultDate = ResultDate & " and " & FullDateFmt

End If

End If

Next

If i = 1 Then

ActiveCell.Value = FullDateFmt

Else

ActiveCell.Value = ResultDate & " and " & Format(DateCol(i), "D MMM,
YYYY")

End If

End Sub

Function SortDate()

Dim i As Long, j As Long, vtemp

For i = 1 To DateCol.Count - 1

For j = i + 1 To DateCol.Count

If DateCol(i) > DateCol(j) Then

vtemp = DateCol(j)

DateCol.Remove j

DateCol.Add vtemp, vtemp, i

End If

Next j

Next i

End Function

Function SameMonthYear() As Boolean

GetMY

SameMonthYear = CurMY = NxtMY

End Function

Function SameMonthYear1() As Boolean

GetMY

SameMonthYear1 = CurMY = PrvMY

End Function

Sub GetMY()

CurMY = Month(DateCol(i)) & Year(DateCol(i))

NxtMY = Month(DateCol(i + 1)) & Year(DateCol(i + 1))

If i > 1 Then PrvMY = Month(DateCol(i - 1)) & Year(DateCol(i - 1))

End Sub
--------------------------------------------------------
Regards,
Shah Shailesh
http://members.lycos.co.uk/shahweb/
http://in.geocities.com/shahshaileshs/
(Excel Add-ins Page)

 

[Jaemun]

Hi Shah Shailesh,

I knew it this could be done!

I can't tell you how much I thank you and highly appreciate for your help.
Your codes works perfectly. Once again thank you very much

Regards,
Jaemun.