Calendar In VBA without ActiveX Control

Dim selecteddate As Date

Dim cbtarget As msforms.ComboBox, cbtarget1 As msforms.ComboBox

Dim myrng As Range

Private Sub ComboBox1_Change()

Dim dayscount

Dim tempvar

Dim dayName

Dim currentdate

Dim i As Integer, j As Integer

Dim cmdbutton1 As msforms.CommandButton

dayName = Format(DateSerial(year(Date), ComboBox1.ListIndex + 1, 1), "ddd")

Dim counter As Integer, daycounter As Integer

Dim cmdbutton() As Variant

dayscount = Day(DateSerial(year(Date), ComboBox1.ListIndex + 2, 0))

cmdbutton = Array("CommandButton1", "CommandButton2", "CommandButton3", "CommandButton4", "CommandButton5", "CommandButton6", "CommandButton7", "CommandButton8", "CommandButton9", "CommandButton10", "CommandButton11", "CommandButton12", "CommandButton13", "CommandButton14", "CommandButton15", "CommandButton16", "CommandButton17", "CommandButton18", "CommandButton19", "CommandButton20", "CommandButton21", "CommandButton22", "CommandButton23", "CommandButton24", "CommandButton25", "CommandButton26", "CommandButton27", "CommandButton28", "CommandButton29", "CommandButton30", "CommandButton31", "CommandButton32", "CommandButton33", "CommandButton34", "CommandButton35", "CommandButton36", "CommandButton37", "CommandButton38")

currentdate = Format(Date, "dd")

If ComboBox1.Value <> vbNullString Then

    If dayName = "Sun" Then

        counter = 0

        daycounter = 1

    ElseIf dayName = "Mon" Then

        Calendar.Controls(cmdbutton(0)).Visible = False

        counter = 1

        daycounter = 1

    ElseIf dayName = "Tue" Then

        Calendar.Controls(cmdbutton(0)).Visible = False

        Calendar.Controls(cmdbutton(1)).Visible = False

        counter = 2

        daycounter = 1

    ElseIf dayName = "Wed" Then

        Calendar.Controls(cmdbutton(0)).Visible = False

        Calendar.Controls(cmdbutton(1)).Visible = False

        Calendar.Controls(cmdbutton(2)).Visible = False

        counter = 3

        daycounter = 1

    ElseIf dayName = "Thu" Then

        Calendar.Controls(cmdbutton(0)).Visible = False

        Calendar.Controls(cmdbutton(1)).Visible = False

        Calendar.Controls(cmdbutton(2)).Visible = False

        Calendar.Controls(cmdbutton(3)).Visible = False

        counter = 4

        daycounter = 1

    ElseIf dayName = "Fri" Then

        Calendar.Controls(cmdbutton(0)).Visible = False

        Calendar.Controls(cmdbutton(1)).Visible = False

        Calendar.Controls(cmdbutton(2)).Visible = False

        Calendar.Controls(cmdbutton(3)).Visible = False

        Calendar.Controls(cmdbutton(4)).Visible = False

        counter = 5

        daycounter = 1

    ElseIf dayName = "Sat" Then

        Calendar.Controls(cmdbutton(0)).Visible = False

        Calendar.Controls(cmdbutton(1)).Visible = False

        Calendar.Controls(cmdbutton(2)).Visible = False

        Calendar.Controls(cmdbutton(3)).Visible = False

        Calendar.Controls(cmdbutton(4)).Visible = False

        Calendar.Controls(cmdbutton(5)).Visible = False

        counter = 6

        daycounter = 1

        

    End If

    For i = counter To (counter + dayscount) - 1

        

        Calendar.Controls(cmdbutton(i)).Visible = True

        Calendar.Controls(cmdbutton(i)).BackColor = RGB(135, 206, 250)

        Calendar.Controls(cmdbutton(i)).ForeColor = RGB(102, 0, 51)

        Calendar.Controls(cmdbutton(i)).FontBold = True

        Calendar.Controls(cmdbutton(i)).Caption = daycounter

        If (daycounter = currentdate) And ((ComboBox1.ListIndex + 1) = Month(Date)) Then

            

            Calendar.Controls(cmdbutton(i)).BackColor = RGB(255, 255, 204)

            

        End If

        daycounter = daycounter + 1

    Next i

    Calendar.Controls(cmdbutton(0)).ForeColor = 255

    Calendar.Controls(cmdbutton(7)).ForeColor = 255

    Calendar.Controls(cmdbutton(14)).ForeColor = 255

    Calendar.Controls(cmdbutton(21)).ForeColor = 255

    Calendar.Controls(cmdbutton(28)).ForeColor = 255

    Calendar.Controls(cmdbutton(35)).ForeColor = 255

    For j = (counter + dayscount) To 37

        Calendar.Controls(cmdbutton(j)).Visible = False

    Next j

End If

End Sub

Private Sub CommandButton1_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton1.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton2_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton2.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton3_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton3.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton4_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton4.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton5_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton5.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton6_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton6.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton7_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton7.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton8_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton8.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton9_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton9.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton10_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton10.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton11_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton11.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton12_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton12.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton13_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton13.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton14_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton14.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton15_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton15.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton16_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton16.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton17_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton17.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton18_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton18.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton19_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton19.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton20_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton20.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton21_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton21.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton22_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton22.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton23_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton23.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton24_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton24.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton25_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton25.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton26_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton26.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton27_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton27.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton28_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton28.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton29_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton29.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton30_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton30.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton31_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton31.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton32_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton32.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton33_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton33.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton34_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton34.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton35_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton35.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton36_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton36.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton37_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton377.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub CommandButton38_Click()

Set cbtarget1 = Calendar.ComboBox2

Set cbtarget = Calendar.ComboBox1

selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton38.Caption)

PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")

Unload Calendar

End Sub

Private Sub Label3_Click()

End Sub

Private Sub UserForm_Initialize()

Set myrng = ThisWorkbook.Sheets(1).Range("L1:L12")

Calendar.BackColor = RGB(188, 143, 143)

Set cbtarget = Me.ComboBox1

Set cbtarget1 = Me.ComboBox2

cbtarget.List = myrng.Cells.Value

cbtarget1.Value = year(Date)

cbtarget.Value = Format(Date, "mmm")

Label3.ForeColor = 255

End Sub

Example of a Nested Select Case using VBA

Sub CheckCell()
Dim Msg As String
Select Case IsEmpty(ActiveCell)
Case True
Msg = "is blank."
Case Else
Select Case ActiveCell.hasFormula
Case True
Msg = "has a formula"
Case False
Select Case IsNumeric(ActiveCell)
Case True
Msg = "has a number"
Case Else
Msg = "has text"
End Select
End Select
End Select
MsgBox "Cell " & ActiveCell.Address & " " & Msg
End Sub

Why to Use Dictionary Object in VBA

VBA has two types of storing collection of datas:

1.Array

2.VBA collection

When you want to compare large data set(A key and Value),Dictionary object is much quicker. Take a reference of Microsoft Scripting Runtime as mentioned below

Advantages of dictionary over Collection are:

1. You can use any value for keys, including numbers. Only requirement is that the key value can be contained in a variant.

2. The Dictionary object's Item member is a read-write property, not a method.

3. The Dictionary object has an Exists method to allow you to check if a key has already been used.

Sub test()

' Declare the dictionaries.

Dim Dict1 As Dictionary

Dim Dict2 As Dictionary

' Create a variant to hold the object.

Dim vContainer1

Dim vContainer2

' Create the dictionary instances.

Set Dict1 = New Dictionary

Set Dict2 = New Dictionary

With Dict1

  'set compare mode

  .CompareMode = BinaryCompare

  ' Add items to the dictionary.

  .Add 1, "Item 1"

  .Add 2, "Item 2"

  .Add 3, "Item 3"

End With

With Dict2

  'set compare mode

  .CompareMode = BinaryCompare

  ' Add items to the dictionary.

  .Add 1, "Item 1a"

  .Add 2, "Item 2"

  .Add 3, "Item 4"

End With

' Compare the two dictionaries.

For Each vContainer1 In Dict1

  If Not Dict2.Exists(vContainer1) Then

    MsgBox vContainer1 & " is in Dict1 but not in Dict2"

  Else ' Item exists so lets check the size.

    If Dict2.Item(vContainer1) <> Dict1.Item(vContainer1) Then

    MsgBox "Key item " & vContainer1 & " is different"

    End If

  End If

Next

End Sub