Multiple toggle buttons on worksheet to trigger a macro - vba

I have 20 toggle buttons set-up like
Public Sub ToggleButton1_Click()
Check_All
If ToggleButton1.value = True Then
ToggleButton1.BackColor = vbGreen
Else:
ToggleButton1.BackColor = vbRed
End If
End Sub
Public Sub ToggleButton2_Click()
Check_All
If ToggleButton2.value = True Then
ToggleButton2.BackColor = vbGreen
Else:
ToggleButton2.BackColor = vbRed
End If
End Sub
I'm attempting to get them triggered by application.onkey like:
Application.OnKey "%a", "Sheet1.ToggleButton1_Click"
Application.OnKey "%b", "Sheet1.ToggleButton2_Click"
And using the Check_all for when all the buttons are "True" it'll do the following that is supposed to revert the toggle buttons back to the "False" state before it triggers another "macro".
Sub Check_All()
Dim tb As Object
For Each tb In Me.OLEObjects
If tb.ProgId = "Forms.ToggleButton.1" Then
If tb.Object.value <> True Then Exit Sub
End If
Next
CommandButton0_Click
End Sub
Private Sub CommandButton0_Click()
Dim x As Integer
For x = 1 To 20
Worksheets("Sheet1").OLEObjects("ToggleButton" & x).Object.value = False
Next x
CommandButton3_Click
End Sub
But I can't seem to get the application.onkey to work and I'm completely lost now.
This is a system that is hooked up to programmable USB buttons and I'm really relying on the onkey to function, unless there's a better way???

You can assign macros to shortcut keys in excel. You need to simulate the toggle-button click like this:
Sub CtrlShiftA()
ToggleButton1.Value = Not ToggleButton1.Value
End Sub
Then have your toggle-button sub as you like:
Private Sub ToggleButton1_Click()
If ToggleButton1.Value = True Then
ToggleButton1.BackColor = vbGreen
Else
ToggleButton1.BackColor = vbRed
End If
End Sub
Then under View -> Macros -> View Macros click Options..:
Press Shift + A to have Ctrl + Shift + A as shortcut key:
Now click OK, and enjoy your shurtcut key.

Related

ActiveX Combobox doesn't close automatically

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 ?

VBA if in text is in textbox then do something

I've written the following code so that if a certain text exists in my listbox and "ok" button is clicked a certain thing is done.
Private Sub CommandButton3_Click()
If (Me.ListBox2.Text) <> ("PA") Then
Call macro1
ElseIf (Me.ListBox2.Text) <> "menu" Then
Sheets("menu").Visible = xlSheetVisible
Worksheets("menu").Activate
Else
MsgBox "Nothing is selected"
End If
End Sub
The problem is that when "ok" is clicked all events are still carried out even if the specified text isn't in the textbox.
You probably want to use = operator, and not <> operator. Also note that ListBox.List(i) is the correct way of getting selected item for single selection mode:
Private Sub CommandButton3_Click()
Dim SelectedItem = ListBox1.List(ListBox1.ListIndex)
If SelectedItem = "PA" Then
Call macro1
ElseIf SelectedItem = "menu" Then
Sheets("menu").Visible = xlSheetVisible
Worksheets("menu").Activate
Else
MsgBox "Nothing is selected"
End If
End Sub
Edit
Following your comment, you can create a function that looks for the existence of that item:
Private Function TextExists(text as String) as Boolean
Dim i as Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.List(i) = text Then
TextExists = True
Exit Function
End If
Next
TextExists = False
End Function
And then use this function in the main code like this:
Private Sub CommandButton3_Click()
If TextExists("PA") Then
Call macro1
ElseIf TextExists("menu") Then
Sheets("menu").Visible = xlSheetVisible
Worksheets("menu").Activate
Else
MsgBox "Nothing is selected"
End If
End Sub
N.B. I have written this manually here, without an IDE. Please check for indexes and other little things.

Nested IF statements for a User Form

My User-Form gives the user an option of 3 colors[red, green, blue] for "High Values" and "Low Values". However, the user must choose one color for each and not the same color for both High and Low Values of course. The colors highlight low and high values within the data in order to differentiate them. I have attached the picture of my User Form and the part of my code where I'm unable to assign different options different colors in order for it work. Any help on how to correct my IF Logic would be greatly appreciated.
Public Function ShowInputsDialog(LowColor As Long, HighValue As Single, HighColor As Long, LowValue As Single)
Call Initialize
Me.Show
If Not Cancel Then
If optRed1.Value Then '<-- Assigning the 3 colors to the Low Values
LowColor = vbRed
ElseIf optGreen1.Value Then
LowColor = vbGreen
Else
LowColor = vbBlue
End If
If optRed2.Value Then HighColor = vbRed '<-- Assigning the 3 colors to the High Values
ElseIf optGreen2.Value Then HighColor = vbGreen
Else
HighColor = vbBlue
End If
End If
HighValue = txtHigher.Value
LowValue = txtLower.Value
ShowInputsDialog = Not Cancel
Unload Me
End Function
I'd go as follows:
add a BeforeUpdate() event for every radio button
have that event handler let the control assume the user input value if compatible with its "counterpart" control one
this, by means of a sub that check the active control value against its "counterpart" one
for instance you could add in your userform code pane the following code:
Private Sub optBlue1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
CrossCheck
End Sub
Private Sub optBlue2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
CrossCheck
End Sub
Private Sub OptGreen1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
CrossCheck
End Sub
Private Sub OptGreen2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
CrossCheck
End Sub
Private Sub OptRed1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
CrossCheck
End Sub
Private Sub OptRed2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
CrossCheck
End Sub
Private Sub CrossCheck()
Dim optNr As String, optName As String
With Me
If .ActiveControl.ActiveControl.Value Then
optName = .ActiveControl.ActiveControl.name
optNr = Mid(optName, Len(optName), 1)
.ActiveControl.ActiveControl.Value = Not (.ActiveControl.ActiveControl.Value = .Controls(Replace(optName, optNr, IIf(optNr = "1", "2", "1"))).Value)
End If
End With
End Sub
of course a Class approach could relieve the burden of writing all those Private Sub optXXXX_BeforeUpdate() event handlers and give you more flexibility for both current coding and future code enhancements, but if you are sticking to only have three radio buttons it could be a little overkill
BTW all what above means that your ShowInputsDialog() sub must not care about option buttons compatibility and can do its plain value assigning work, for which I'd use a Select Case syntax instead of the If Then - Else If Then - End If one:
If Not Cancel Then
Select Case True
Case OptRed1.Value
LowColor = vbRed
Case OptGreen1.Value
LowColor = vbGreen
Case Else
LowColor = vbBlue
End Select
Select Case True
Case OptRed2.Value
HighColor = vbRed
Case OptGreen2.Value
HighColor = vbGreen
Case Else
HighColor = vbBlue
End Select
End If
or you could use a helper function:
Function GetColor(opt1 As MSForms.OptionButton, opt2 As MSForms.OptionButton) As Long
Select Case True
Case opt1.Value
GetColor = vbRed
Case opt2.Value
GetColor = vbGreen
Case Else
GetColor = vbBlue
End Select
End Function
and simply write
If Not Cancel Then
LowColor = GetColor(OptRed1, OptGreen1)
HighColor = GetColor(OptRed2, OptGreen2)
End If

Close UserForm if All Data Captured

Say you have aUserForm with TextBox1, TextBox3, TextBox3 and an OK Button.
To only allow the UserForm to close if all three TextBox have data I would use the following script assigned to the OK Button:
Private Sub CommandButton1_Click()
If Len(TextBox1.Value) >= 1 And _
Len(TextBox2.Value) >= 1 And _
Len(TextBox3.Value) >= 1 Then
Me.Hide
Else
MsgBox "Please Complete All Fields!"
End If
End Sub
Is there another way to do this besides an If statement?
Direct User Before Errors Are Made
Preferable to informing a user after an invalid action has been made is to prevent the user from performing that invalid action in the first place[1]. One way to do this is to use the Textbox_AfterUpdate event to call a shared validation routine that controls the Enabled property of your OK button, and also controls the display of a status label. The result is a more informative interface that only allows valid actions, thereby limiting the nuisance of msgbox popups. Here's some example code and screenshots.
Private Sub TextBox1_AfterUpdate()
RunValidation
End Sub
Private Sub TextBox2_AfterUpdate()
RunValidation
End Sub
Private Sub TextBox3_AfterUpdate()
RunValidation
End Sub
Private Sub RunValidation()
If Len(TextBox1.Value) = 0 Or Len(TextBox2.Value) = 0 Or Len(TextBox3.Value) = 0 Then
CommandButton1.Enabled = False
Label1.Visible = True
Else
CommandButton1.Enabled = True
Label1.Visible = False
End If
End Sub
Private Sub CommandButton1_Click()
Me.Hide
End Sub
The If Statement
As far as the If statement is concerned, there are a ton of ways that can be done, but I think anything other than directly evaluating TextBox.Value leads to unnecessary plumbing and code complexity, so I think it's hard to argue for anything other than the If statement in the OP. That being said, this particular If statement can be slightly condensed by capitalizing on its numeric nature, which allows for
Len(TextBox1.Value) = 0 Or Len(TextBox2.Value) = 0 Or Len(TextBox3.Value) = 0
to be replaced with
Len(TextBox1.Value) * Len(TextBox2.Value) * Len(TextBox3.Value) = 0
Although that doesn't gain you much and is arguably less readable code, it does allow for a condensed one liner, especially if the textboxes are renamed...
If Len(TB1.Value) * Len(TB2.Value) * Len(TB3.Value) = 0 Then
.Value vs .Text
Lastly, in this case, I think .Value should be used instead of .Text. .Text is more suited for validating a textbox entry while its being typed, but in this case, you're looking to validate a textbox's saved data, which is what you get from .Value.
More User feedback - Colorization
I almost forgot, I wanted to include this example of how to include even more user feedback. There is a balance between providing useful feedback and overwhelming with too much. This is especially true if the overall form is complicated, or if the intended user has preferences, but color indication for key fields is usually beneficial. A lot of applications may present the form without color at first and then colorize it if the user is having trouble.
Private InvalidColor
Private ValidColor
Private Sub UserForm_Initialize()
InvalidColor = RGB(255, 180, 180)
ValidColor = RGB(180, 255, 180)
TextBox1.BackColor = InvalidColor
TextBox2.BackColor = InvalidColor
TextBox3.BackColor = InvalidColor
End Sub
Private Sub TextBox1_AfterUpdate()
RunValidation Me.ActiveControl
End Sub
Private Sub TextBox2_AfterUpdate()
RunValidation Me.ActiveControl
End Sub
Private Sub TextBox3_AfterUpdate()
RunValidation Me.ActiveControl
End Sub
Private Sub RunValidation(ByRef tb As MSForms.TextBox)
If Len(tb.Value) > 0 Then
tb.BackColor = ValidColor
Else
tb.BackColor = InvalidColor
End If
If Len(TextBox1.Value) * Len(TextBox2.Value) * Len(TextBox3.Value) = 0 Then
CommandButton1.Enabled = False
Label1.Visible = True
Else
CommandButton1.Enabled = True
Label1.Visible = False
End If
End Sub
Private Sub CommandButton1_Click()
Me.Hide
End Sub
As I said in my comment, that is an ok way to do it. But i'll post this just so you have an example of another way. This would allow you to evaluate what is going into the text boxes as they are set.
Option Explicit
Dim bBox1Value As Boolean
Dim bBox2Value As Boolean
Dim bBox3Value As Boolean
Private Sub TextBox1_Change()
If Trim(TextBox1.Text) <> "" Then
bBox1Value = True
End If
End Sub
Private Sub TextBox2_Change()
If Trim(TextBox2.Text) <> "" Then
bBox2Value = True
End If
End Sub
Private Sub TextBox3_Change()
If Trim(TextBox3.Text) <> "" Then
bBox3Value = True
End If
End Sub
Private Sub CommandButton1_Click()
If bBox1Value = True And bBox2Value = True And bBox3Value = True Then
Me.Hide
Else
MsgBox "Please Complete All Fields!"
End If
End Sub
You can use a loop:
Private Sub CommandButton1_Click()
Dim n as long
For n = 1 to 3
If Len(Trim(Me.Controls("TextBox" & n).Value)) = 0 Then
MsgBox "Please Complete All Fields!"
Exit Sub
End If
Next n
Me.Hide
End Sub
You can use the below code
Private Sub CommandButton1_Click()
If Trim(TextBox1.Value & vbNullString) = vbNullString And _
Trim(TextBox2.Value & vbNullString) = vbNullString And _
Trim(TextBox3.Value & vbNullString) = vbNullString Then
Me.Hide
Else
MsgBox "Please Complete All Fields!"
End If
End Sub
I got the answer from this question
VBA to verify if text exists in a textbox, then check if date is in the correct format

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