Pop Up Choice Box Macro

[MikeG]

I wonder if anyone could help me create a macro that does the following:

When the user hits Ctrl L, a popup box appears with 5 choices - each with an option button. The first choice says "Today". The second choice says "Yesterday" and then the next three choices are the previous three days, each shown in ddd mmm format.

When the user selects one of the five choices and then presses OK, the macro puts the value of the chosen date in the current cell.

If some could help by telling me what code calls up the basic box, that would be great. If someone could give me the whole thing, that would even more appreciated.

Thanks,

Mikeg

 

[John_w]

You could do this with a macro which displays a userform, assigning a shortcut key to the macro. However you can't use Ctrl+L because Ctrl+ any upper case character is reserved to Excel itself. You could use Ctrl+l (lower case L) or Ctrl+Shift+L.

Record a macro and assign your chosen shortcut key to it, then change the code to:

Sub Macro1()
' Keyboard Shortcut: Ctrl+Shift+L
    
    Dim myForm As UserForm1
    Set myForm = UserForm1
    myForm.Show
End Sub

Create a userform with 5 option buttons on it (OptionButton1, OptionButton2, etc.) and a command button (CommandButton1). Put the following code in the UserForm1 module:

Option Explicit

Private Sub UserForm_Initialize()
    Me.OptionButton1.Value = True       'default selected option button
    Me.OptionButton1.Caption = "Today"
    Me.OptionButton2.Caption = "Yesterday"
    Me.OptionButton3.Caption = Format(Date - 2, "dd mmm")
    Me.OptionButton4.Caption = Format(Date - 3, "dd mmm")
    Me.OptionButton5.Caption = Format(Date - 4, "dd mmm")
End Sub

Private Sub CommandButton1_Click()
    
    Dim theDate As Date
    
    If Me.OptionButton1.Value Then
        theDate = Date
    ElseIf Me.OptionButton2.Value Then
        theDate = Date - 1
    ElseIf Me.OptionButton3.Value Then
        theDate = Date - 2
    ElseIf Me.OptionButton4.Value Then
        theDate = Date - 3
    ElseIf Me.OptionButton5.Value Then
        theDate = Date - 4
    End If
    
    With ActiveCell
        .FormulaR1C1 = theDate
        .NumberFormat = "dd mmmm yyyy"
    End With
    
End Sub

 

[MikeG]

Thanks John - just what I was looking for.

Mike

 

[MikeG]

Is it possible to change the code so that no option is pre-selected when the form opens. The user then selects one date and then that value is pasted with no need for the command button? i.e. one click action.

Thanks

 

[djreiswig]

Get rid of all of the userform code and the command button, and paste this code into the userform. It should do what you want.

Option Explicit
Private Sub UserForm_Initialize()
    Me.OptionButton1.Caption = "Today"
    Me.OptionButton2.Caption = "Yesterday"
    Me.OptionButton3.Caption = Format(Date - 2, "dd mmm")
    Me.OptionButton4.Caption = Format(Date - 3, "dd mmm")
    Me.OptionButton5.Caption = Format(Date - 4, "dd mmm")
End Sub
Private Sub OptionButton1_Click()
    Dim theDate As Date
    theDate = Date
    With ActiveCell
        .FormulaR1C1 = theDate
        .NumberFormat = "dd mmmm yyyy"
    End With
    Unload Me
End Sub
Private Sub OptionButton2_Click()
    Dim theDate As Date
    theDate = Date - 1
    With ActiveCell
        .FormulaR1C1 = theDate
        .NumberFormat = "dd mmmm yyyy"
    End With
    Unload Me
End Sub
Private Sub OptionButton3_Click()
    Dim theDate As Date
    theDate = Date - 2
    With ActiveCell
        .FormulaR1C1 = theDate
        .NumberFormat = "dd mmmm yyyy"
    End With
    Unload Me
End Sub
Private Sub OptionButton4_Click()
    Dim theDate As Date
    theDate = Date - 3
    With ActiveCell
        .FormulaR1C1 = theDate
        .NumberFormat = "dd mmmm yyyy"
    End With
    Unload Me
End Sub
Private Sub OptionButton5_Click()
    Dim theDate As Date
    theDate = Date - 4
    With ActiveCell
        .FormulaR1C1 = theDate
        .NumberFormat = "dd mmmm yyyy"
    End With
    Unload Me
End Sub

 

[MikeG]

Excellent - thanks to both of you.

MikeG

 

[mikerickson]

Create a userform (named Userform1) with one ListBox (named ListBox1) and 2 Command Buttons (butOK and butCancel).

Put this code in that userform's code module.

Public Function ChosenDate() As Double
    With Me
        With .ListBox1
            .AddItem "Today"
            .AddItem "Yesterday"
            .AddItem Date - 2
            .AddItem Date - 3
            .AddItem Date - 4
        End With
        .Show
    End With
    
    With UserForm1.ListBox1
        If -1 < .ListIndex Then
            ChosenDate = CDbl(Date - .ListIndex)
        End If
    End With
    
    Unload UserForm1
End Function

Private Sub butOK_Click()
    Me.Hide
End Sub

Private Sub butCancel_Click()
    Unload Me
End Sub

Private Sub ListBox1_Change()
    Me.butOK.Enabled = True
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call butOK_Click
End Sub

Private Sub UserForm_Initialize()
    Me.ListBox1.ListStyle = fmListStyleOption
    Me.butOK.Enabled = False
End Sub

Then put this code in a normal module and assign it the hot-key combination of choice.

Sub test()
    Dim uiDate As Double
    uiDate = UserForm1.ChosenDate
    
    If uiDate = 0 Then
        Rem cancel pressed
    Else
        ActiveCell.Value = uiDate
    End If
End Sub

 

[MikeG]

One last thing. Is it possible to change this part of the code so that if the user has selected more than one sell before running the macro, theDate will be posted to those mutiple cells, not just the active one?

With ActiveCell
.FormulaR1C1 = theDate
.NumberFormat = "dd mmmm yyyy"
End With


Thaks

 

[mikerickson]

Just change ActiveCell to Selection.

 

[MikeG]

Just change ActiveCell to Selection.

Thank you.

MikeG