Creating a userform on the fly and deleting it when done - naming the userform

A

AndyGalloway

Board Regular
Joined
Apr 24, 2019
Messages
51
I have some code. It used to create a userform called "myUserForm". However, now it just creates "UserForm4", then the next time it is run it creates "UserForm5", then "UserForm6", etc. I must have made a change to something, but I can't figure out what that something could be. I have only included down to the second line of code because by this time "UserForm4" has already been created in the VBE where previously "myUserForm" used to be created by this stage. I have tried declaring myUserForm as an object, but that didn't work. I am using Excel 2016. What am I doing wrong?

Interestingly, I have a lot of code that comes after this code that refers to the userform and the controls on it as "myUserForm". However, when I come to delete it or refer to it in the "Cancel" routine, "myUserForm" is nowhere to be found. If I use "UserForm4" for these commands, it works perfectly. However, I want the userform to be deleted on exit and created again the next time it is needed.

Code: 
Dim myUserForm As VBComponent


    Set myUserForm = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
    With myUserForm
    ...
 
Sort by date Sort by votes
Just to be clear, because I don't see that anyone has made it explicit. This isn't true:
Apparently, you can't add coding to a control in a userform that already exists. The only way to do what I need is to create the whole userform and all the controls in it from scratch at run time.
Click to expand...
It's very easy to add controls at runtime to a pre-existing form, as a rule of thumb if you are writing code with code, you are doing it wrong.

Writing code with code requires end users to lower their security settings in a rather obscure place and is explicitly opt in - it's better not to ask them to change this.

You can easily add controls to an existing userform at runtime without doing any VBE automation, it's really easy, all you need to do is create a class to handle the events raised by the controls you've added:

consider:

userform code
Rich (BB code): 
Dim handlers As Collection

Private Sub UserForm_Initialize()
    
    
    Dim x As Long
    Dim y As Long
    Dim btn As MSForms.CommandButton
    Dim handler As ButtonHandler
    
    Const width = 45
    Const height = 30
    
    Me.width = 510
    Me.height = 530
    
    Set handlers = New Collection
    
    For x = 1 To 10
        For y = 1 To 10
            Set btn = Me.Controls.Add("Forms.CommandButton.1")
            Set handler = New ButtonHandler
            Set handler.CommandButton = btn
            handlers.Add handler
            With btn
                .height = height
                .width = width
                .Top = (x * height) - height
                .Left = (y * width) - width
                .Caption = "R" & x & "C" & y
            End With
        Next y
    Next x
    

End Sub

In a class called: ButtonHandler
Rich (BB code): 
Public WithEvents CommandButton As MSForms.CommandButton

Private Sub CommandButton_Click()
    MsgBox CommandButton.Caption & " was clicked"
End Sub
 
Upvote 0
I have a UserForm with Multipages.

On each Multipage Page I have the controls I need for that particular Job.

But I assume you already know that. Just seems hard to me to have to add controls and all sorts of code depending on what task your trying to perform.
 
Upvote 0
I have further amended your AddClass code to look like this.

Code: 
Private Sub AddClass()


    Dim NewMod As Object
    'Delete the Class Module "Colours" if it exists
    On Error Resume Next
    Set NewClass = ThisWorkbook.VBProject.VBComponents("Colour")
    ThisWorkbook.VBProject.VBComponents.Remove NewClass
    On Error GoTo 0
    Dim z As Long


    'Add the Class Module to capture the Image Click Event
    Set NewClass = ThisWorkbook.VBProject.VBComponents.Add(2)
    NewClass.Name = "Colour"


    With NewClass.CodeModule
        z = .CountOfLines
        .InsertLines z + 1, "Public WithEvents ClrCntrl As Image"
        .InsertLines z + 2, "Private Sub ClrCntrl_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single)"
        .InsertLines z + 3, ""
        .InsertLines z + 4, "    ClrCntrl.SpecialEffect = fmSpecialEffectSunken"
        .InsertLines z + 5, "    " & NewForm.Name & ". backcolor = ClrCntrl.backcolor"
        .InsertLines z + 6, "    " & NewForm.Name & ".Caption = ""Control colour is "" & ClrCntrl.BackColor"
        .InsertLines z + 7, ""
        .InsertLines z + 8, "End Sub"
    End With
    
    'Add the code for the UserForm
    Set NewMod = ThisWorkbook.VBProject.VBComponents(NewForm.Name)
    With NewMod.CodeModule
        z = .CountOfLines
        .InsertLines z + 1, "Private AA(1 To 56) As New Colour"
        .InsertLines z + 2, "Private Sub UserForm_Initialize()"
        .InsertLines z + 3, "Dim IM As Control, i as Long"
        .InsertLines z + 4, "i = 1"
        .InsertLines z + 5, "    "
        .InsertLines z + 6, "For Each IM In " & NewForm.Name & ".Controls"
        .InsertLines z + 7, "    Set AA(i).ClrCntrl = IM"
        .InsertLines z + 8, "    i = i + 1"
        .InsertLines z + 9, "Next"
        .InsertLines z + 10, "    "
        .InsertLines z + 11, "End Sub"
    End With
    
    Dim objButton As MSForms.CommandButton
    Dim myString1 As String
  '  Dim z As Long
  
    Set objButton = NewForm.Designer.Controls.Add("Forms.CommandButton.1", "btnTest", True)
    With objButton
        .Caption = "Test"
        .Left = 80
        .Width = 66
        .Height = 24
        .Top = 76
    End With
    
    With NewMod.CodeModule
    myString1 = "    MsgBox ""That worked"", vbOKOnly, ""Success!"""
        z = .CountOfLines
        .InsertLines z + 1, "Sub btnTest_Click()"
        .InsertLines z + 2, "    "
        .InsertLines z + 3, myString1
        .InsertLines z + 4, "    "
        .InsertLines z + 5, "End Sub"
    End With
    
End Sub

Now I get a runtime error - "Error 13 Type mismatch", but no indication of where the problem is

Code: 
    Set AA(i).ClrCntrl = IM
 
Upvote 0
I'm still struggling with this one. Following advice from people posting on this forum, I have reverted to a permanently available UserForm (UserForm3) and have placed the minimum controls on the userform (Save button and cancel button) and have placed their codes in their click events. The code to create all other labels, text boxes, check boxes and buttons on the fly all works fine. Now, how do I attach code to the buttons that were created on the fly? They are created by a loop and are named "btnMoveUp1", "btnMoveUp2", etc. Just a simple example of MsgBox "Clicked button " & f ,,"Success" would be fine. How can I access the codemodule of UserForm3 to write this.

Code: 
Sub btnMoveUp1_Click()

    MsgBox "Clicked on button 1", vbOkOnly, "Success"

End Sub

Sub btnMoveUp2_Click()

    MsgBox "Clicked on button 2", vbOkOnly, "Success"

End Sub
 
Upvote 0
You said:
Now, how do I attach code to the buttons that were created on the fly?

I think that is what your going to find is the hardest part.

Your wanting Vba code to write vba code.

If the button will always do the same thing. Why write the code for the button on the fly.

Or if not always the same give us a example of what a button might be used for in one case and what it might be needed to do in another case.



​
 
Last edited:
Upvote 0
AndyGalloway said:
I'm still struggling with this one. Following advice from people posting on this forum, I have reverted to a permanently available UserForm (UserForm3) and have placed the minimum controls on the userform (Save button and cancel button) and have placed their codes in their click events. The code to create all other labels, text boxes, check boxes and buttons on the fly all works fine. Now, how do I attach code to the buttons that were created on the fly? They are created by a loop and are named "btnMoveUp1", "btnMoveUp2", etc. Just a simple example of MsgBox "Clicked button " & f ,,"Success" would be fine. How can I access the codemodule of UserForm3 to write this.

Code: 
Sub btnMoveUp1_Click()

    MsgBox "Clicked on button 1", vbOkOnly, "Success"

End Sub

Sub btnMoveUp2_Click()

    MsgBox "Clicked on button 2", vbOkOnly, "Success"

End Sub
Click to expand...

This is exactly what my post above shows you how to do. Don’t write code with code, there’s absolutely no need

It adds 100 command buttons to an existing form and adds their event handlers
 
Last edited:
Upvote 0
I figured out the missing step. If I use the below code to detect "myUserForm" and delete it if it does exist, then I can create a new "myUserForm" using the code listed previously. The key was in the save command immediately following the deletion of the userform.

Code: 
    ' First, check the form doesn't already exist
    For n = 1 To ActiveWorkbook.VBProject.VBComponents.Count
        If ActiveWorkbook.VBProject.VBComponents(n).Name = "myUserForm" Then
            With ActiveWorkbook.VBProject
                .VBComponents.Remove .VBComponents("myUserForm")
                ActiveWorkbook.Save
            End With
        End If
    Next n
 
Upvote 0
I have created a date-picker calendar form because my workplace version of Excel does not have the form date-picker function. It will create a form calendar to select any date from. It will place that date into the currently active cell. Studying the code can give you a basic understanding of how to create a form on the fly.

I developed it for the date-picking form to be created on the fly and then deleted after use. However you can comment out the line of code that deletes the userform and code it for use as you would any other userform. To achieve this simply comment out the very last line of code in the dateGetter() subroutine. The line that removes the userform is "ThisWorkbook.VBProject.VBComponents.Remove myForm."

The subroutine setGUIDReferences() at the very top of the code below is a list of tool references that can be set by GUID reference numbers. The one necessary for the date-picking form is the MS Forms reference. Make sure this reference is added or the form will not work. You can either set the reference with this subroutine or yoiu can go to Tools -> References and select Microsoft Forms 2.0 Object Library.

To create and open the date-picking form just put your cursor inside the dateGetter() subroutine and run it with PF5. The form will be created and open.

The proper usage when deleting the userform after each use is:

VBA Code: 
Sub test_Date_Picker()
        Call dateGetter
        ActiveCell = absDate
End Sub

When not deleting after each use you would simply call it like any other form:

VBA Code: 
Sub test_Date_Picker()
        UserForm1.Show   '  The default name is UserForm1.  Once created you can change the name to anything you prefer
        ActiveCell = absDate
End Sub

Simply put the following code into a standard code module. Note that the variable "absDate" is global and must be global in order to work.

VBA Code: 
Public absDate As Date

Sub setGUIDReferences()
'   NOTE:  The dateGetter() sub will not work until the MSForms Reference is added to this workbook project
'   You can add the MSForms reference by running this sub first
'   Or go to Tools --> References and select the MSForms reference there
'   included below are several other common references you can use for other projects just uncomment them to add
'   *************************************************************************************************************

    On Error Resume Next
    'ThisWorkbook.VBProject.References.AddFromGuid "{000204EF-0000-0000-C000-000000000046}", 0, 0    '       Visual Basic For Applications
    'ThisWorkbook.VBProject.References.AddFromGuid "{00020813-0000-0000-C000-000000000046}", 0, 0    '       Microsoft Excel 16.0 Object Library
    'ThisWorkbook.VBProject.References.AddFromGuid "{00020430-0000-0000-C000-000000000046}", 0, 0    '       OLE Automation
    'ThisWorkbook.VBProject.References.AddFromGuid "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}", 0, 0    '       Microsoft Office 16.0 Object Library
    ThisWorkbook.VBProject.References.AddFromGuid "{0D452EE1-E08F-101A-852E-02608C4D0BB4}", 0, 0    '       Microsoft Forms 2.0 Object Library
    'ThisWorkbook.VBProject.References.AddFromGuid "{3050F1C5-98B5-11CF-BB82-00AA00BDCE0B}", 0, 0    '       Microsoft HTML Object Library
    'ThisWorkbook.VBProject.References.AddFromGuid "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}", 0, 0    '       Microsoft Internet Controls
    'ThisWorkbook.VBProject.References.AddFromGuid "{420B2830-E718-11CF-893D-00A0C9054228}", 0, 0    '       Microsoft Scripting Runtime
    'ThisWorkbook.VBProject.References.AddFromGuid "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}", 0, 0    '       Microsoft Windows Common Controls-2 6.0 (SP6)
    'ThisWorkbook.VBProject.References.AddFromGuid "{4AFFC9A0-5F99-101B-AF4E-00AA003F0F07}", 0, 0    '       Microsoft Access 16.0 Object Library
    'ThisWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 0, 0    '       Microsoft Visual Basic for Applications Extensibility 5.3
    'ThisWorkbook.VBProject.References.AddFromGuid "{F5078F18-C551-11D3-89B9-0000F81FE221}", 0, 0    '       Microsoft MSXML2 for XML Scraping
    On Error GoTo 0
End Sub

Sub dateGetter()
'   This creates dategetter userform for those without access to date picker
'   Bug Fixed: Aug 2020, Selecting Original Date was resulting in 12:00:00 AM

'*********
'   Note: MSForms Reference in Tools menu must be added to workbook first before this calendar script will work
'   You can add several commonly used references by running the "setGUIDReferences()" subroutine above.
'   Or go to Tools --> References and select the MSForms reference there
'*********

Dim myForm As Object, calendarForm As Object, newLabel As MSForms.Label, newSpinner As MSForms.SpinButton
Dim NewFrame As MSForms.Frame
Dim NewButton As MSForms.CommandButton, newButton2 As MSForms.CommandButton
Dim NewListBox As MSForms.ListBox
Dim smallDayArray
Dim xDiff As Long
Dim smallTextArray
Dim startDate As Date
Dim endDate As Date
   
    Set myForm = ThisWorkbook.VBProject.VBComponents.Add(3)
   
    'Create the User Form
    With myForm
        .Properties("Caption") = "Select Date Range"
        .Properties("Width") = 247.5
        .Properties("Height") = 350
    End With
   
    'create button
    Set NewButton = myForm.Designer.Controls.Add("Forms.commandbutton.1")
    With NewButton
        .Name = "CommandButton1"
        .Top = 288
        .Left = 138
        .Width = 42
        .Height = 24
        .Font.Size = 10
        .Font.Name = "Tahoma"
        .Caption = "Cancel"
    End With
   
    'create button
    Set NewButton = myForm.Designer.Controls.Add("Forms.commandbutton.1")
    With NewButton
        .Name = "CommandButton2"
        .Top = 288
        .Left = 186
        .Width = 42
        .Height = 24
        .Font.Size = 10
        .Font.Name = "Tahoma"
        .Caption = "Select"
    End With
   
   
    'create frame
    Set NewFrame = myForm.Designer.Controls.Add("Forms.frame.1")
    With NewFrame
        .Name = "Frame1"
        .Top = 54
        .Left = 24
        .Width = 192
        .Height = 180
        .Font.Size = 9
        .Font.Name = "Tahoma"
    End With
   
    'Create label1
    Set newLabel = myForm.Designer.Controls.Add("Forms.Label.1")
    With newLabel
        .Name = "Label1"
        .Top = 30
        .Left = 30
        .Width = 102
        .Height = 18
        .Font.Size = 12
        .Font.Name = "Tahoma"
        .ForeColor = RGB(128, 0, 0)
        .BackColor = RGB(256, 256, 256)
        .Caption = "November 2017"
    End With
   
    'Create label2
    Set newLabel = myForm.Designer.Controls.Add("Forms.Label.1")
    With newLabel
        .Name = "Label2"
        .Top = 258
        .Left = 36
        .Width = 174
        .Height = 18
        .Font.Size = 12
        .Font.Name = "Tahoma"
        .ForeColor = RGB(0, 0, 0)
        .Caption = "01/01/2017"
    End With
   
   
    'Create SpinButton1
    Set newSpinner = myForm.Designer.Controls.Add("Forms.spinbutton.1")
    With newSpinner
        .Name = "SpinButton1"
        .Top = 24
        .Left = 144
        .Width = 12.75
        .Height = 25
    End With
   
    'Create Calendar Header Labels
    smallDayArray = Array("S", "M", "T", "W", "T", "F", "S")
    smallTextArray = Array("day1", "day2", "day3", "day4", "day5", "day6", "day7")
    xDiff = 18
    For i = LBound(smallDayArray) To UBound(smallDayArray)
        Set lbl = NewFrame.Controls.Add("Forms.Label.1")
        With lbl
            .Name = smallTextArray(i)
            .Top = 6
            .Left = xDiff
            .Width = 12
            .Height = 18
            .Font.Size = 11
            .Font.Name = "Tahoma"
            .Caption = smallDayArray(i)
        End With
        xDiff = xDiff + 24
    Next i
   
    'Create Calendar boxes labels
    arrCounter = 1
    For j = 1 To 6
        xDiff = 12
        For k = 1 To 7
            Set lbl = NewFrame.Controls.Add("Forms.Label.1")
            With lbl
                .Name = "lb_" & arrCounter
                Select Case j
                    Case 1
                        .Top = 24
                    Case 2
                        .Top = 48
                    Case 3
                        .Top = 72
                    Case 4
                        .Top = 96
                    Case 5
                        .Top = 120
                    Case 6
                        .Top = 144
                End Select
                .Left = xDiff
                .Width = 18
                .Height = 18
                .Font.Size = 11
                .Font.Name = "Tahoma"
                .Caption = " " & arrCounter
                .ForeColor = RGB(128, 0, 0)
                .BackColor = RGB(256, 256, 256)
            End With
            arrCounter = arrCounter + 1
            xDiff = xDiff + 24
        Next k
    Next j
    ''add code for form module
    myForm.CodeModule.InsertLines 1, "Private Sub CommandButton1_Click()"
    myForm.CodeModule.InsertLines 2, "absDate = 0"
    myForm.CodeModule.InsertLines 3, "Unload Me"
    myForm.CodeModule.InsertLines 4, "End Sub"
    myForm.CodeModule.InsertLines 5, ""
    myForm.CodeModule.InsertLines 6, "Private Sub SpinButton1_SpinDown()"
    myForm.CodeModule.InsertLines 7, "Dim newDate1 As Date"
    myForm.CodeModule.InsertLines 8, "    newDate1 = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & " 1, " & Chr(34) & " & Right(Label1.Caption, 4))"
    myForm.CodeModule.InsertLines 9, "    newDate1 = DateAdd(" & Chr(34) & "m" & Chr(34) & ", -1, newDate1)"
    myForm.CodeModule.InsertLines 10, "    Label1.Caption = MonthName(Month(newDate1)) & " & Chr(34) & " " & Chr(34) & " & Year(newDate1)"
    myForm.CodeModule.InsertLines 11, "    Call clearBoxes"
    myForm.CodeModule.InsertLines 12, "   Run fillCal(newDate1)"
    myForm.CodeModule.InsertLines 13, "End Sub"
    myForm.CodeModule.InsertLines 14, "Private Sub SpinButton1_SpinUp()"
    myForm.CodeModule.InsertLines 15, "Dim newDate1 As Date"
    myForm.CodeModule.InsertLines 16, "    newDate1 = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & " 1, " & Chr(34) & " & Right(Label1.Caption, 4))"
    myForm.CodeModule.InsertLines 17, "    newDate1 = DateAdd(" & Chr(34) & "m" & Chr(34) & ", 1, newDate1)"
    myForm.CodeModule.InsertLines 18, "    Label1.Caption = MonthName(Month(newDate1)) & " & Chr(34) & " " & Chr(34) & " & Year(newDate1)"
    myForm.CodeModule.InsertLines 19, "    Call clearBoxes"
    myForm.CodeModule.InsertLines 20, "    Run fillCal(newDate1)"
    myForm.CodeModule.InsertLines 21, "End Sub"
    myForm.CodeModule.InsertLines 22, "Function dhDaysInMonth2(Optional dtmDate As Date = 0) As Integer"
    myForm.CodeModule.InsertLines 23, "    ' Return the number of days in the specified month.  Written by Chip Pierson"
    myForm.CodeModule.InsertLines 24, "    If dtmDate = 0 Then"
    myForm.CodeModule.InsertLines 25, "        ' Did the caller pass in a date? If not, use"
    myForm.CodeModule.InsertLines 26, "        ' the current date."
    myForm.CodeModule.InsertLines 27, "        dtmDate = Date"
    myForm.CodeModule.InsertLines 28, "    End If"
    myForm.CodeModule.InsertLines 29, "    dhDaysInMonth2 = DateSerial(Year(dtmDate), _ "
    myForm.CodeModule.InsertLines 30, "     Month(dtmDate) + 1, 1) - _ "
    myForm.CodeModule.InsertLines 31, "     DateSerial(Year(dtmDate), Month(dtmDate), 1)"
    myForm.CodeModule.InsertLines 32, "End Function"
    myForm.CodeModule.InsertLines 33, "Public Sub UserForm_Activate()"
    myForm.CodeModule.InsertLines 34, "Dim currentDate As Date"
    myForm.CodeModule.InsertLines 35, ""
    myForm.CodeModule.InsertLines 36, " For i = 1 To 42" & vbNewLine
    myForm.CodeModule.InsertLines 37, "     txt = txt & " & Chr(34) & "Private Sub lb_" & Chr(34) & " & i & " & Chr(34) & "_Click()" & Chr(34) & " & vbNewLine" & vbNewLine
    myForm.CodeModule.InsertLines 38, "     txt = txt & " & Chr(34) & "Dim newDate As Date" & Chr(34) & " & vbNewLine" & vbNewLine
    myForm.CodeModule.InsertLines 39, " txt = txt & " & Chr(34) & "newDate = DateValue(Mid(Label1.Caption, 1, Len(Label1.Caption) - 5) &" & Chr(34) & " & Chr(34) &   " & Chr(34) & Chr(34) & " & lb_" & " & i & " & Chr(34) & ".Caption & " & Chr(34) & " & Chr(34) & " & Chr(34) & ", " & Chr(34) & " & Chr(34) & " & Chr(34) & " & Right(Label1.Caption, 4))" & Chr(34) & " & vbNewLine" & vbNewLine
    myForm.CodeModule.InsertLines 40, "     txt = txt & " & Chr(34) & "Label2.Caption = " & Chr(34) & " & Chr(34) & " & Chr(34) & "Date:  " & Chr(34) & " & Chr(34) & " & Chr(34) & " & newDate" & Chr(34) & " & vbNewLine" & vbNewLine
    myForm.CodeModule.InsertLines 41, "txt = txt & " & Chr(34) & "End Sub" & Chr(34) & " & vbNewLine" & vbNewLine
    myForm.CodeModule.InsertLines 42, "Next i" & vbNewLine
    myForm.CodeModule.InsertLines 43, ""
    myForm.CodeModule.InsertLines 44, "Label2.Caption =  Chr(34) &  Chr(34) "
    myForm.CodeModule.InsertLines 45, "currentDate = DateValue(Month(Date) & " & Chr(34) & " 1" & Chr(34) & " & " & Chr(34) & ", " & Chr(34) & " & Year(Date))"
    myForm.CodeModule.InsertLines 46, "Run fillCal(currentDate)"
    myForm.CodeModule.InsertLines 47, "End Sub"
    myForm.CodeModule.InsertLines 48, "Function fillCal(startDate As Date)"
    myForm.CodeModule.InsertLines 49, "Dim currentDayOfMonth As Integer, i As Integer"
    myForm.CodeModule.InsertLines 50, "currentDayOfMonth = Day(Date)"
    myForm.CodeModule.InsertLines 51, "Dim startCal As Date, currentMonth as Integer"
    myForm.CodeModule.InsertLines 52, "Dim labelArray, sumVar3 As Long"
    myForm.CodeModule.InsertLines 53, "    Label2.Caption = " & Chr(34) & "" & Chr(34)
    myForm.CodeModule.InsertLines 54, "    labelArray = Array(" & Chr(34) & "lb_1" & Chr(34) & ", " & Chr(34) & "lb_2" & Chr(34) & ", " & Chr(34) & "lb_3" & Chr(34) & ", " & Chr(34) & "lb_4" & Chr(34) & ", " & Chr(34) & "lb_5" _
                                                                & Chr(34) & ", " & Chr(34) & "lb_6" & Chr(34) & ", " & Chr(34) & "lb_7" & Chr(34) & ", " & Chr(34) & "lb_8" & Chr(34) & ", " & Chr(34) & "lb_9" & Chr(34) & ", " & Chr(34) _
                                                                & "lb_10" & Chr(34) & ", " & Chr(34) & "lb_11" & Chr(34) & ", " & Chr(34) & "lb_12" & Chr(34) & ", " & Chr(34) & "lb_13" & Chr(34) & ", " & Chr(34) & "lb_14" & Chr(34) & ", " & Chr(34) & "lb_15" & Chr(34) & ",  _"
    myForm.CodeModule.InsertLines 55, "                      " & Chr(34) & "lb_16" & Chr(34) & ", " & Chr(34) & "lb_17" & Chr(34) & ", " & Chr(34) & "lb_18" & Chr(34) & ", " & Chr(34) & "lb_19" & Chr(34) & ", " & Chr(34) & "lb_20" & Chr(34) & ", " & _
                                                                Chr(34) & "lb_21" & Chr(34) & ", " & Chr(34) & "lb_22" & Chr(34) & ", " & Chr(34) & "lb_23" & Chr(34) & ", " & Chr(34) & "lb_24" & Chr(34) & ", " & Chr(34) & "lb_25" & Chr(34) & ", " & _
                                                                Chr(34) & "lb_26" & Chr(34) & ", " & Chr(34) & "lb_27" & Chr(34) & ", " & Chr(34) & "lb_28" & Chr(34) & ", " & Chr(34) & "lb_29" & Chr(34) & ", " & Chr(34) & "lb_30" & Chr(34) & ", " & Chr(34) & "lb_31" & Chr(34) & ", _"
    myForm.CodeModule.InsertLines 56, "                      " & Chr(34) & "lb_32" & Chr(34) & ", " & Chr(34) & "lb_33" & Chr(34) & ", " & Chr(34) & "lb_34" & Chr(34) & ", " & Chr(34) & "lb_35" & Chr(34) & ", " & Chr(34) & "lb_36" & Chr(34) & ", " & _
                                                                Chr(34) & "lb_37" & Chr(34) & ", " & Chr(34) & "lb_38" & Chr(34) & ", " & Chr(34) & "lb_39" & Chr(34) & ", " & Chr(34) & "lb_40" & Chr(34) & ", " & Chr(34) & "lb_41" & Chr(34) & ", " & Chr(34) & "lb_42" & Chr(34) & ")"
    myForm.CodeModule.InsertLines 57, "    Label1 = MonthName(Month(startDate)) & " & Chr(34) & " " & Chr(34) & " & Year(startDate)"
    myForm.CodeModule.InsertLines 58, "    sumVar3 = Weekday(startDate) - 1"
    myForm.CodeModule.InsertLines 59, "    "
    myForm.CodeModule.InsertLines 60, "    For i = LBound(labelArray) To UBound(labelArray)"
    myForm.CodeModule.InsertLines 61, "            Me.Controls(labelArray(i)).Caption = " & Chr(34) & "" & Chr(34) & ""
    myForm.CodeModule.InsertLines 62, "    Next i"
    myForm.CodeModule.InsertLines 63, "    "
    myForm.CodeModule.InsertLines 64, "     For i = 1 To dhDaysInMonth2(startDate)"
    myForm.CodeModule.InsertLines 65, "         Me.Controls(labelArray(sumVar3)).Caption = i"
    myForm.CodeModule.InsertLines 66, "         If currentDayOfMonth = i And month(Date) = Month(StartDate)  And Year(Date) = Year(StartDate) Then"
    myForm.CodeModule.InsertLines 67, "             Me.Controls(labelArray(sumVar3)).BackColor = RGB(256, 0, 0)"
    myForm.CodeModule.InsertLines 68, "             Me.Controls(labelArray(sumVar3)).ForeColor = RGB(256, 256, 256)"
    myForm.CodeModule.InsertLines 69, "             Label2.Caption = " & Chr(34) & "Date:  " & Chr(34) & " & DateValue(Month(startDate) & " & Chr(34) & "/" & Chr(34) & " & i & " & Chr(34) & "/" & Chr(34) & " & Year(startDate))"
    myForm.CodeModule.InsertLines 70, "        End If"
    myForm.CodeModule.InsertLines 71, "        sumVar3 = sumVar3 + 1"
    myForm.CodeModule.InsertLines 72, "     Next i"
    myForm.CodeModule.InsertLines 73, "    "
    myForm.CodeModule.InsertLines 74, "End Function"
    myForm.CodeModule.InsertLines 75, "Private Sub CommandButton2_Click()"
    myForm.CodeModule.InsertLines 76, "    absDate = Replace(Me.Label2.Caption, " & Chr(34) & "Date:  " & Chr(34) & ", " & Chr(34) & Chr(34) & "):Unload Me"
    myForm.CodeModule.InsertLines 77, "End Sub"
    myForm.CodeModule.InsertLines 78, "Private Sub clearBoxes()"
    myForm.CodeModule.InsertLines 79, "Dim labelArray"
    myForm.CodeModule.InsertLines 80, "     Label2.Caption = " & Chr(34) & "" & Chr(34)
    myForm.CodeModule.InsertLines 81, "    labelArray = Array(" & Chr(34) & "lb_1" & Chr(34) & ", " & Chr(34) & "lb_2" & Chr(34) & ", " & Chr(34) & "lb_3" & Chr(34) & ", " & Chr(34) & "lb_4" & Chr(34) & ", " & Chr(34) & "lb_5" _
                                                                & Chr(34) & ", " & Chr(34) & "lb_6" & Chr(34) & ", " & Chr(34) & "lb_7" & Chr(34) & ", " & Chr(34) & "lb_8" & Chr(34) & ", " & Chr(34) & "lb_9" & Chr(34) & ", " & Chr(34) _
                                                                & "lb_10" & Chr(34) & ", " & Chr(34) & "lb_11" & Chr(34) & ", " & Chr(34) & "lb_12" & Chr(34) & ", " & Chr(34) & "lb_13" & Chr(34) & ", " & Chr(34) & "lb_14" & Chr(34) & ", " & Chr(34) & "lb_15" & Chr(34) & ",  _"
    myForm.CodeModule.InsertLines 82, "                      " & Chr(34) & "lb_16" & Chr(34) & ", " & Chr(34) & "lb_17" & Chr(34) & ", " & Chr(34) & "lb_18" & Chr(34) & ", " & Chr(34) & "lb_19" & Chr(34) & ", " & Chr(34) & "lb_20" & Chr(34) & ", " & _
                                                                Chr(34) & "lb_21" & Chr(34) & ", " & Chr(34) & "lb_22" & Chr(34) & ", " & Chr(34) & "lb_23" & Chr(34) & ", " & Chr(34) & "lb_24" & Chr(34) & ", " & Chr(34) & "lb_25" & Chr(34) & ", " & _
                                                                Chr(34) & "lb_26" & Chr(34) & ", " & Chr(34) & "lb_27" & Chr(34) & ", " & Chr(34) & "lb_28" & Chr(34) & ", " & Chr(34) & "lb_29" & Chr(34) & ", " & Chr(34) & "lb_30" & Chr(34) & ", " & Chr(34) & "lb_31" & Chr(34) & ", _"
    myForm.CodeModule.InsertLines 83, "                      " & Chr(34) & "lb_32" & Chr(34) & ", " & Chr(34) & "lb_33" & Chr(34) & ", " & Chr(34) & "lb_34" & Chr(34) & ", " & Chr(34) & "lb_35" & Chr(34) & ", " & Chr(34) & "lb_36" & Chr(34) & ", " & _
                                                                Chr(34) & "lb_37" & Chr(34) & ", " & Chr(34) & "lb_38" & Chr(34) & ", " & Chr(34) & "lb_39" & Chr(34) & ", " & Chr(34) & "lb_40" & Chr(34) & ", " & Chr(34) & "lb_41" & Chr(34) & ", " & Chr(34) & "lb_42" & Chr(34) & ")"
    myForm.CodeModule.InsertLines 84, "      For i = lbound(labelArray) to ubound(labelArray)"
    myForm.CodeModule.InsertLines 85, "         Me.Controls(labelArray(i)).BackColor = RGB(256, 256, 256)"
    myForm.CodeModule.InsertLines 86, "         Me.Controls(labelArray(i)).ForeColor = RGB(0, 0, 0)"
    myForm.CodeModule.InsertLines 87, "      next i"
    myForm.CodeModule.InsertLines 88, "End Sub"
    '   add click controls for date label boxes
    Dim myCounter As Long
    myCounter = 89
        For i = 1 To 42
            myForm.CodeModule.InsertLines myCounter, "Private Sub lb_" & i & "_Click()"
            myCounter = myCounter + 1
            myForm.CodeModule.InsertLines myCounter, "Dim newDate As Date"
            myCounter = myCounter + 1
            myForm.CodeModule.InsertLines myCounter, "Call clearBoxes"
            myCounter = myCounter + 1
            myForm.CodeModule.InsertLines myCounter, "absDate = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & Chr(32) & Chr(34) & " & lb_" & i & ".Caption & " & Chr(34) & ", " & Chr(34) & Chr(38) & " Right(Label1.Caption, 4))"
            myCounter = myCounter + 1
            myForm.CodeModule.InsertLines myCounter, "Label2.Caption = " & Chr(34) & "Date:  " & Chr(34) & " & absDate" & vbNewLine
            myCounter = myCounter + 1
            myForm.CodeModule.InsertLines myCounter, "lb_" & i & ".backcolor = rgb(256,0,0)"
            myCounter = myCounter + 1
            myForm.CodeModule.InsertLines myCounter, "lb_" & i & ".forecolor = rgb(256,256,256)"
            myCounter = myCounter + 1
            myForm.CodeModule.InsertLines myCounter, "End Sub" & vbNewLine
            myCounter = myCounter + 1
    Next i
    'Add and show new userform
    absDate = Format(Date, "mm/dd/yyyy")
    Set calendarForm = VBA.UserForms.Add(myForm.Name)
    calendarForm.Show
   
   
    If absDate <> 0 Then
    '   Here is where you put your code to to use the selected date
    '   whhich is in the global variabole "absDate"
        startDate = absDate
        Debug.Print "Your First Date is " & startDate
    Else
        Beep
        MsgBox "You did not select a date"
        GoTo endItAll
    End If
   
   
    
endItAll:
    '   Uncomment the following line if you want to delete the form after using it
    ThisWorkbook.VBProject.VBComponents.Remove myForm
End Sub
Function dhDaysInMonth(Optional dtmDate As Date = 0) As Integer
    ' Return the number of days in the specified month.  Written by Chip Pierson
    If dtmDate = 0 Then
        ' Did the caller pass in a date? If not, use
        ' the current date.
        dtmDate = Date
    End If
    dhDaysInMonth2 = DateSerial(Year(dtmDate), _
     Month(dtmDate) + 1, 1) - _
     DateSerial(Year(dtmDate), Month(dtmDate), 1)
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question Question
Creating a Userform programmatically Error.
Replies
3
Views
661
Dan_W
D
E
  • Solved
Userform to look up data, and delete if necessary
Replies
5
Views
153
dmt32
D
E
  • Question Question
Restrict Cursor Movement Inside a Userform
Replies
1
Views
327
Domenic
D
Skyybot
  • Solved
Excel VBA - Run Time Error
Replies
1
Views
264
DanteAmor
DanteAmor
SeniorNewbie
  • Solved
Create/Delete/Reset module and userform by VBA
Replies
8
Views
790
Domenic
D

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top