ActiveX Combobox doesn't close automatically - vba

I have an ActiveX Combobox in one of my main sheet which control/update a series of charts.
Private Sub cmBoxSelect_GotFocus()
Application.ScreenUpdating = False
With Me.cmBoxSelect
.List = Array("Grand Total", "Prod1", "Prod2", "Prod3", "Prod4", "Prod5")
.ListRows = 6
.DropDown
End With
Application.ScreenUpdating = True
End Sub
Private Sub cmBoxSelect_Change()
'series of codes which manipulates the charts, based on selection...
End Sub
I noticed that when I click the ComboBox and select one of its content, it leaves a blue highlight on the selection. So to prevent that, I added:
Private Sub cmBoxSelect_DropButtonClick()
Application.ScreenUpdating = False
ActiveCell.Activate
Application.ScreenUpdating = True
End Sub
It successfully removed the highlight.
However, it has a weird drawback. cmbSelect doesn't close automatically once user didn't select anything (once the combobox is active and the user click any cell in the sheet, it doesn't close out). It was working before I added the DropButtonClick event.
Did I missed anything or any wrong steps above? Thanks for your inputs!
EDIT#1
Seems I already found a solution by trial and error. I only added a blank Label and select it to remove the focus out of the ComboBox whenever there is a change. I also changed the DropButtonClick to LostFocus.
Private Sub cmBoxSelect_GotFocus()
Application.ScreenUpdating = False
With Me.cmBoxSelect
.List = Array("Grand Total", "Prod1", "Prod2", "Prod3", "Prod4", "Prod5")
.ListRows = 6
.DropDown
End With
Application.ScreenUpdating = True
End Sub
Private Sub cmBoxSelect_LostFocus()
ActiveCell.Select
End Sub
Private Sub cmBoxSelect_Change()
'series of codes which manipulates the charts, based on selection...
Me.Label1.Select
End Sub

You need to put the SelLength to 0 in multiple events to avoid highlighting:
so:
Me.cmBoxSelect.SelLength = 0
in:
Private Sub cmBoxSelect_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Private Sub cmBoxSelect_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Private Sub cmBoxSelect_LostFocus()
Private Sub cmBoxSelect_DropButtonClick()
Private Sub cmBoxSelect_Change()
Private Sub cmBoxSelect_GotFocus()
(you could add also Me.cmBoxSelect.SelStart = 0 )

Lets try this:
Not Event-triggered by a change, but by the dropbuttonclick
Private Sub changingComboBox(String s)
'series of codes which manipulates the charts, based on selection...
End Sub
Private Sub cmBoxSelect_DropButtonClick()
Dim s As String
s = cmBoxSelect.SelText
If (cmBoxSelect.SelText = cmBoxSelect.Value) Then
cmBoxSelect.Value = ""
cmBoxSelect.Value = s
Else
call changingComboBox(cmBoxSelect.Value)
End If
End Sub
How about that ?

Related

Code to account for all checkboxes in a userform?

I have code on a userform that contains several checkboxes and several DTPickers.
The code looks like so:
Private Sub CheckBox11_Click()
If CheckBox11.Value = True Then
DTPicker22.Enabled = True
Else
DTPicker22.Enabled = False
End If
End Sub
Private Sub CheckBox12_Click()
If CheckBox12.Value = True Then
DTPicker24.Enabled = True
Else
DTPicker24.Enabled = False
End If
End Sub
The Userform contains a lot of checkboxes that have clauses next to them. Upon their completion the DTPicker will enable entering the date of completion.
Whilst this does what I want, it only enables one DTPicker when the checkbox is ticked per private sub. There has to be some way to make this so I wouldn't need to create different private subs for every checkbox click event.
Could you also tell me where to put it, as in, what event?
A "control array" is the typical approach for something like this.
See:
http://www.siddharthrout.com/index.php/2018/01/15/vba-control-arrays/
eg:
Class module clsEvents
Option Explicit
'Handle events for a checkbox and a date control, associated with a worksheet cell
Private WithEvents m_CB As MSForms.CheckBox
Private WithEvents m_DP As DTPicker
Private m_dateCell As Range
'set up the controls and the cell
Public Sub Init(cb As MSForms.CheckBox, dp As DTPicker, rng As Range)
Set m_CB = cb
Set m_DP = dp
Set m_dateCell = rng
If rng.Value > 0 Then
cb.Value = True
m_DP.Value = rng.Value
Else
cb.Value = False
End If
m_DP.CustomFormat = "dd/MM/yyyy"
End Sub
Private Sub m_CB_Change()
m_DP.Enabled = (m_CB.Value = True)
End Sub
Private Sub m_DP_Change()
m_dateCell.Value = m_DP.Value 'update the cell
End Sub
Userform:
Option Explicit
Dim colObj As Collection 'needs to be a Global to stay in scope
Private Sub UserForm_Activate()
Dim obj As clsEvents, i As Long, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set colObj = New Collection
'loop over controls and create a class object for each set
' 3 pairs of controls on my test form...
For i = 1 To 3
Set obj = New clsEvents
obj.Init Me.Controls("CheckBox" & i), _
Me.Controls("DTPicker" & i), _
ws.Cells(i, "B")
colObj.Add obj
Next i
End Sub
The first thing I'd recommend is following a proper naming convention. "CheckBox11" and "DTPciker1" are really vague and once you get further into your code, you'll forget which control is which. I would recommend naming them something that relates the two control together, like "firstDate" and "firstDateDTP". My alternate answer below uses this approach.
You could make a public function that enables the DTPicker based upon the checkbox's value.
Public Function EnableDTPicker(myPicker as String, enableBool as Boolean)
UserFormName.Controls(myPicker).Enabled = enableBool
End Function
Then, you can call the function in your CheckBox123_Click() subs like this:
Private Sub CheckBox123_Click()
EnableDTPicker("thePickerName", CheckBox123.Value)
End Sub
Alternatively, you could make a timer event that runs x number of seconds that just loops through the controls and performs the checks as needed. See this page on how to set up the timer. Using the code in the link shown, You could do something along the lines of:
'Put this in Workbook events
Private Sub Workbook_Open()
alertTime = Now + TimeValue("00:00:01")
Application.OnTime alertTime, "EventMacro"
UserForm1.Show
End Sub
'Put this in a Module
Public Sub EventMacro()
With UserForm1
For each ctrl in .Controls
If TypeName(ctrl) = "CheckBox" Then
'The code below assumes the naming convention outlined above is followed
.Controls(ctrl.Name & "DTP").Enabled = ctrl.Value
End If
Next ctrl
End With
alertTime = Now + TimeValue("00:00:01")
Application.OnTime alertTime, "EventMacro"
End Sub

VBA SetFocus on Keydown not working if checkbox true?

I have the following form in excel. It is part of a simple inventory worksheet, and is used to update the status of items. It was functioning as intended, however when I tried to add in a checkbox to make the selected status persist (allowing me to only type in the serial rather than serial and status every time when working with a batch of items) I noticed that the focus after submitting cycles forward as if I pressed tab rather than being where I set it with SetFocus.
I'm presuming this is an oversight related to either the event cycle for KeyDown or nested If/Else logic, but I've had no luck actually diagnosing it. I've only recently started using VBA, and there are a lot of quirks I'm trying to understand.
Private Sub clear()
Me.txtSerial = ""
If cbPersist.Object.Value = False Then
Me.cboxStatus = ""
Me.cboxStatus.SetFocus
Else
Me.txtSerial.SetFocus
End If
End Sub
Private Sub submit()
Dim loc As Range
Dim ws As Worksheet
Set ws = Worksheets("Full Inventory")
Set loc = ws.Columns("B").Find(what:=Me.txtSerial.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not loc Is Nothing Then
ActiveWindow.ScrollRow = loc.Row
ws.Cells(loc.Row, 10).Value = Me.cboxStatus.Value
Else
MsgBox "Serial not found."
End If
clear
End Sub
Private Sub txtSerial_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
submit
ElseIf KeyCode = vbKeyEscape Then
clear
End If
End Sub
Private Sub UserForm_Initialize()
cboxStatus.List = Array("Stock", "Shipped", "Research", "Sent Back", "Return")
End Sub
Suggest the following:
Code snippet of UserForm module
Private Sub txtSerial_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
submit
KeyCode = vbKeyPageDown ' << modify Enter key value to prevent from tab hopping
ElseIf KeyCode = vbKeyEscape Then
clear
End If
End Sub

Userform closes after "End Sub" without ever calling "Unload Me"

I have a userform (baseUF) that has multiple pages and buttons that all do different things. I have this baseUF being modeless because I want the user to be able to play with the sheet without closing the userform and losing all of the data they input. However, I started having a problem that might be due to the modeless nature of the baseUF.
There are other userforms that can be called from the baseUF. One executes with no issue by double clicking a textbox. However, the other userform is loaded after a button click. Once that button click sub is finished, the baseUF closes after the Exit Sub OR End Sub line. I don't remember this happening in the past and it doesn't happen with any other button click subs.
Does anybody have an idea what the issue could be? I'm pretty lost because I don't have a command to close the baseUF anywhere in that sub. Below is some code to show what is happening:
This sub is connected to a button on the spreadsheet to open the baseUF (the code is in a module).
Sub Button1_Click()
' show the userform
baseUF.Show vbModeless
End Sub
And this is the sub in the baseUF that calls an additional userform (LoadBox) which seems to be the issue.
Private Sub LoadQuery_Click()
' I Dim a bunch of stuff here
' if there are no saved queries, alert the user
If saveSht.Range("B3").Value = "" Then
MsgBox "No saved queries!"
Exit Sub
' if there is only one saved query, add it to the array and pop up the userform that allows for the user to select which save to load
ElseIf saveSht.Range("B4").Value = "" Then
save_names = saveSht.Range("B3").Value
LoadBox.Show
' otherwise, add all of the save names to the array and pop up that userform
Else
save_names = saveSht.Range(saveSht.Range("B3"),saveSht.Range("B3").End(xlDown)).Value
LoadBox.Show
End If
' if the user didn't select a save to load, stop trying to make stuff happen
If load_name = "" Then
' the userform will also close here if this turns out to be true
Exit Sub
End If
' do a bunch of stuff with the selected name here
' and after this line, the userform that contains this code closes
End Sub
EDIT: here is some code showing the two other userforms
This one is the userform with no issue that is called after a textbox is double clicked
Private Sub UserForm_Initialize()
' On start up of this form, populate the listbox with the relevant column names
' Set position
Me.StartUpPosition = 0
Me.Top = baseUF.Top + 0.5 * baseUF.Height - 0.5 * Me.Height
Me.Left = baseUF.Left + 0.5 * baseUF.Width - 0.5 * Me.Width
With FilterSelectionBox
' First grab all of the column names from the main selected table
For i = 0 To baseUF.SelectionBox.ListCount - 1
.AddItem baseUF.SelectionBox.List(i)
Next i
' Then grab all of the column names from the additional tables to be joined
If Not IsVariantEmpty(join_table_cols) Then
For n = 0 To UBound(join_table_cols)
If Not IsEmpty(join_table_cols(n)) Then
For Each col_name In join_table_cols(n)
.AddItem col_name
Next
End If
Next n
End If
End With
End Sub
Private Sub OkButton_Click()
' Initialize the variables
Dim tb As MSForms.TextBox
Dim arr() As String
Dim str As String
' tb is the textbox object that the column names will be pasted in to
Set tb = baseUF.MultiPage1.Pages(baseUF.MultiPage1.Value).Controls(Me.Tag)
' sets the str according to some logic
' This is actually where it gets sent
tb.Value = str
' And close the form
Unload Me
End Sub
And this is the code in the userform with an issue
Private Sub UserForm_Initialize()
' On initialization, populate the combobox with all of the save names present in the spreadsheet
' Set position
Me.StartUpPosition = 0
Me.Top = baseUF.Top + 0.5 * baseUF.Height - 0.5 * Me.Height
Me.Left = baseUF.Left + 0.5 * baseUF.Width - 0.5 * Me.Width
With LoadComb
' If there is more than one save present, go through the array and add each one
If IsArray(save_names) Then
For Each saved_name In save_names
.AddItem saved_name
Next
' Otherwise just add the one
Else
.AddItem save_names
End If
End With
End Sub
Private Sub LoadButton_Click()
' When the user hits the load button, first check if they actually selected anything
If LoadComb.Value = "" Then
' If they didn't, yell at them
MsgBox "No saved query selected!"
Else
' Otherwise, save the name to a global variable
load_name = LoadComb.Value
End If
' Close the form
Unload Me
End Sub
Whenever something unexpected happens with forms, consider writing End in the immediate window and pressing enter. It will kill all the unkilled instances of a form and generally any variable, thus it would be like a cold restart to the VBA program.
After doing this, it is a good idea to consider a cleaner solution, concerning VBA & UserForms, using some OOP. (Disclaimer - the first article is mine):
http://www.vitoshacademy.com/vba-the-perfect-userform-in-vba/
https://rubberduckvba.wordpress.com/2017/10/25/userform1-show/
https://codereview.stackexchange.com/questions/154401/handling-dialog-closure-in-a-vba-user-form
Although it may seem that you are achieving the same results with more code, the benefits of using this approach are quite a lot in the long term.
This is a small example of the OOP model. Imagine you have a user form like this:
It has only the following controls:
btnRun
btnExit
lblInfo
frmMain (the class)
The code withing the form is the following:
Option Explicit
Public Event OnRunReport()
Public Event OnExit()
Public Property Get InformationText() As String
InformationText = lblInfo.Caption
End Property
Public Property Let InformationText(ByVal value As String)
lblInfo.Caption = value
End Property
Public Property Get InformationCaption() As String
InformationCaption = Caption
End Property
Public Property Let InformationCaption(ByVal value As String)
Caption = value
End Property
Private Sub btnRun_Click()
RaiseEvent OnRunReport
End Sub
Private Sub btnExit_Click()
RaiseEvent OnExit
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
Hide
End If
End Sub
The form is with two events, getting caught by the clsSummaryPresenter. The clsSummaryPresenter looks like this:
Option Explicit
Private WithEvents objSummaryForm As frmMain
Private Sub Class_Initialize()
Set objSummaryForm = New frmMain
End Sub
Private Sub Class_Terminate()
Set objSummaryForm = Nothing
End Sub
Public Sub Show()
If Not objSummaryForm.Visible Then
objSummaryForm.Show vbModeless
Call ChangeLabelAndCaption("Press Run to Start", "Starting")
End If
With objSummaryForm
.Top = CLng((Application.Height / 2 + Application.Top) - .Height / 2)
.Left = CLng((Application.Width / 2 + Application.Left) - .Width / 2)
End With
End Sub
Private Sub Hide()
If objSummaryForm.Visible Then objSummaryForm.Hide
End Sub
Public Sub ChangeLabelAndCaption(strLabelInfo As String, strCaption As String)
objSummaryForm.InformationText = strLabelInfo
objSummaryForm.InformationCaption = strCaption
objSummaryForm.Repaint
End Sub
Private Sub objSummaryForm_OnRunReport()
MainGenerateReport
Refresh
End Sub
Private Sub objSummaryForm_OnExit()
Hide
End Sub
Public Sub Refresh()
With objSummaryForm
.lblInfo = "Ready"
.Caption = "Task performed"
End With
End Sub
Finally, we have the modMain, which is the so-called business logic of the form:
Option Explicit
Private objPresenter As clsSummaryPresenter
Public Sub MainGenerateReport()
objPresenter.ChangeLabelAndCaption "Starting and running...", "Running..."
GenerateNumbers
End Sub
Public Sub GenerateNumbers()
Dim lngLong As Long
Dim lngLong2 As Long
tblMain.Cells.Clear
For lngLong = 1 To 10
For lngLong2 = 1 To 10
tblMain.Cells(lngLong, lngLong2) = lngLong * lngLong2
Next lngLong2
Next lngLong
End Sub
Public Sub ShowMainForm()
If (objPresenter Is Nothing) Then
Set objPresenter = New clsSummaryPresenter
End If
objPresenter.Show
End Sub

How to call the DateTimePicker from a textbox in UserForm

I have created a TextBox1 within my UserForm.
I have create a Sub called
Sub TextBox1_Enter()
End Sub
where by clicking the textbox I want to open the DateTimePicker control to choose a date, and after the date is chosen the chosen date should be the TextBox1.Value
I have the DateTimePicker from mscomct2.ocx
I really don't figure out how to call the control; any tips with code and a good explanation anyone?
I'm not sure if this is exactly what you are looking for but you could take a look as this. It is very well explained.
My goal was to have an empty DatePicker at form startup, and was told to use a textbox to load the DTPicker upon clicking.
But I found this solution that keep the DTPicker Value empty as form startup
Private Sub DTPicker1_CloseUp()
FormatDTPicker
End Sub
Private Sub DTPicker1_Format(ByVal CallbackField As String, FormattedString As String)
If CallbackField = "X" Then FormattedString = ""
End Sub
Private Sub DTPicker1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal_
x As stdole.OLE_XPOS_PIXELS, ByValy As stdole.OLE_YPOS_PIXELS)
With DTPicker1
If .Value = vbNull Then
.Value = Now
End If
End With
End Sub
Private Sub UserForm_Initialize()
DTPicker1.Value = vbNull
FormatDTPicker
End Sub
Private Sub FormatDTPicker()
With DTPicker1
If .Value = vbNull Then
.Format = dtpCustom
.CustomFormat = "X"
Else
.Format = dtpShortDate
End If
End With
End Sub
http://www.mrexcel.com/forum/excel-questions/666685-dtpicker-value-null.html

Remove shadow from ActiveX Option Button in Excel 2010 VBA

I was trying to emphasis the option button from activeX control when it is selected by user. I decided to show the shadow when it is selected and then hide the shadow when user selects other option button. The first process is working whereas the shadow cannot be removed even though I select other button. My VBA code is shown below:
Private Sub OptionButton1_Click()
OptionButton1.Shadow = False
If OptionButton1.Value = True Then
OptionButton1.Shadow = True
Else
OptionButton1.Shadow = False
End If
End Sub
Can anyone please help me to solve this?
In case of FORMS buttons you can use
Sub RemoveFormsButtonShadows()
'A.Leine 21/10/2015
For Each Button In ActiveSheet.Shapes
Button.Select
Selection.ShapeRange.Shadow.Visible = False
Next Button
End Sub
For that you have to create one sub which needs to be called from all the option buttons that you have. This common sub will simply remove the shadow from all option buttons. Here I am taking the example of 3 option buttons.
Option Explicit
Private Sub OptionButton1_Click()
RemoveShadow
If OptionButton1.Value = True Then _
OptionButton1.Shadow = True
End Sub
Private Sub OptionButton2_Click()
RemoveShadow
If OptionButton2.Value = True Then _
OptionButton2.Shadow = True
End Sub
Private Sub OptionButton3_Click()
RemoveShadow
If OptionButton3.Value = True Then _
OptionButton3.Shadow = True
End Sub
Sub RemoveShadow()
Dim objOpt As OLEObject
With ActiveSheet
For Each objOpt In .OLEObjects
If TypeName(objOpt.Object) = "OptionButton" Then
objOpt.Shadow = False
End If
Next
End With
End Sub