Simplify toggle button change BackColor Code VBA - vba

im new in VBA making, so all code below is still working tho but it takes a lot of line of codes. Even it is easier to maintain but if someone can simplify my noob-code to cut some lines and more eye-pleasing?
there are more than 20 toggle buttons in my userform
this is the example of my code, need help for make it simpler
Private Sub tgglC_Result1_Click()
If tgglC_Result1.Value = True Then
tgglC_Result1.BackColor = &HFF00&
tgglNC_Result1.Enabled = False
lblResult1.Caption = Now
lblResult1.Visible = True
Else
tgglC_Result1.BackColor = &H8000000F
tgglNC_Result1.Enabled = True
lblResult1.Visible = False
End If
End Sub
Private Sub tgglC_Result2_Click()
If tgglC_Result2.Value = True Then
tgglC_Result2.BackColor = &HFF00&
tgglNC_Result2.Enabled = False
lblResult2.Caption = Now
lblResult2.Visible = True
Else
tgglC_Result2.BackColor = &H8000000F
tgglNC_Result2.Enabled = True
lblResult2.Visible = False
End If
End Sub
Private Sub tgglC_Result3_Click()
If tgglC_Result3.Value = True Then
tgglC_Result3.BackColor = &HFF00&
tgglNC_Result3.Enabled = False
lblResult3.Caption = Now
lblResult3.Visible = True
Else
tgglC_Result3.BackColor = &H8000000F
tgglNC_Result3.Enabled = True
lblResult3.Visible = False
End If
End Sub
Private Sub tgglC_Result4_Click()
If tgglC_Result4.Value = True Then
tgglC_Result4.BackColor = &HFF00&
tgglNC_Result4.Enabled = False
lblResult4.Caption = Now
lblResult4.Visible = True
Else
tgglC_Result4.BackColor = &H8000000F
tgglNC_Result4.Enabled = True
lblResult4.Visible = False
End If
End Sub

best way should be using a Class
but a more "conventional" way could help you reducing typing burden, too:
define a unique toggle control handling sub
Private Sub tgglC_Result_Click()
Dim NC As Control
With Me
Set NC = .Controls(VBA.Replace(.ActiveControl.Name, "tgglC", "tgglNC")) '<--| set the "counter part" toggle button control of the "Active" control (i.e. the one being currently toggled)
With .ActiveControl
.BackColor = IIf(.Value, &HFF00&, &H8000000F)
NC.Enabled = Not .Value
End With
End With
End Sub
call it from any of your event handler
Private Sub tgglC_Result1_Click()
tgglC_Result_Click
End Sub
Private Sub tgglC_Result2_Click()
tgglC_Result_Click
End Sub
Private Sub tgglC_Result3_Click()
tgglC_Result_Click
End Sub
...

Not really a simplifying solution, but this is what I used when I needed to supply logic to 60+ controls on an Access subform (similar task to yours):
Sub makeCode()
Dim i As Integer
For i = 1 To 4
Debug.Print "Private Sub tgglC_Result" & i & "_Click()"
Debug.Print "tgglC_Result" & i & ".BackColor = &HFF00&"
Debug.Print "tgglNC_Result2.Enabled = False"
Debug.Print "lblResult" & i & ".Caption = Now"
Debug.Print "lblResult" & i & ".Visible = True"
Debug.Print "End Sub"
Debug.Print ""
Next
End Sub
Copy the result from the Immediate window into the code editor. It's easy to change all the subroutines, too: just change the loop body, run it, and replace old code.

Related

Microsoft Excel VBA - Run-Time Error 438

I appear to be having an error which I am struggling to figure out the reason. I have tried the help sections and also tried researching it online but have not come up with any results. I am hoping someone may be able to assist me in the matter.
Issue
I have created multiple forms for different sheets on my spreadsheet. I have made forms which can be used to hide/show select column(s) by user discretion. I have two forms which work perfectly fine, but on the third.
I get
Run-Time Error 438 "Object doesn't support this property or method"
What does this mean? The code is the exact same as the other forms. The only difference in them is that the names of the sheets are different.
I will paste the code below for the sheets. Hopefully you can distinguish which is which. I will try and do my best to explain.
Code below
Main sheet - contains button to form open form
Private Sub openUserForm_Click()
chkFormCooms.Show
End Sub
Userform
Option Explicit
Sub hideCol(C As Integer)
If Controls("CheckBox" & C) = True Then
Columns(C).Hidden = True
Else
Columns(C).Hidden = False
End If
ActiveWindow.ScrollColumn = 1
End Sub
Private Sub chkP1_Click()
If Me.chkP1.Value = True Then
Sheets("Cooms").Columns("T:W").Hidden = True
Sheets("chkCooms").chk1.Value = True
ElseIf Me.chkP1.Value = False Then
Sheets("Cooms").Columns("T:W").Hidden = False
Sheets("chkCooms").chk1.Value = False
End If
End Sub
Private Sub chkP2_Click()
If Me.chkP2.Value = True Then
Sheets("Cooms").Columns("X:AA").Hidden = True
Sheets("chkCooms").chk2.Value = True
ElseIf Me.chkP2.Value = False Then
Sheets("Cooms").Columns("X:AA").Hidden = False
Sheets("chkCooms").chk2.Value = False
End If
End Sub
Private Sub chkP3_Click()
If Me.chkP3.Value = True Then
Sheets("Cooms").Columns("AB:AE").Hidden = True
Sheets("chkCooms").chk3.Value = True
ElseIf Me.chkP3.Value = False Then
Sheets("Cooms").Columns("AB:AE").Hidden = False
Sheets("chkCooms").chk3.Value = False
End If
End Sub
Private Sub chkP4_Click()
If Me.chkP4.Value = True Then
Sheets("Cooms").Columns("AF:AI").Hidden = True
Sheets("chkCooms").chk4.Value = True
ElseIf Me.chkP4.Value = False Then
Sheets("Cooms").Columns("AF:AI").Hidden = False
Sheets("chkCooms").chk4.Value = False
End If
End Sub
Private Sub chkP5_Click()
If Me.chkP5.Value = True Then
Sheets("Cooms").Columns("AJ:AM").Hidden = True
Sheets("chkCooms").chk5.Value = True
ElseIf Me.chkP5.Value = False Then
Sheets("Cooms").Columns("AJ:AM").Hidden = False
Sheets("chkCooms").chk5.Value = False
End If
End Sub
Private Sub chkP6_Click()
If Me.chkP6.Value = True Then
Sheets("Cooms").Columns("AN:AQ").Hidden = True
Sheets("chkCooms").chk6.Value = True
ElseIf Me.chkP6.Value = False Then
Sheets("Cooms").Columns("AN:AQ").Hidden = False
Sheets("chkCooms").chk6.Value = False
End If
End Sub
Private Sub chkP7_Click()
If Me.chkP7.Value = True Then
Sheets("Cooms").Columns("AR:AU").Hidden = True
Sheets("chkCooms").chk7.Value = True
ElseIf Me.chkP7.Value = False Then
Sheets("Cooms").Columns("AR:AU").Hidden = False
Sheets("chkCooms").chk7.Value = False
End If
End Sub
Private Sub chkP8_Click()
If Me.chkP8.Value = True Then
Sheets("Coomst").Columns("AV:AY").Hidden = True
Sheets("chkCooms").chk8.Value = True
ElseIf Me.chkP8.Value = False Then
Sheets("Cooms").Columns("AV:AY").Hidden = False
Sheets("chkCooms").chk8.Value = False
End If
End Sub
Private Sub chkP9_Click()
If Me.chkP9.Value = True Then
Sheets("Cooms").Columns("AZ:BC").Hidden = True
Sheets("chkCooms").chk9.Value = True
ElseIf Me.chkP9.Value = False Then
Sheets("Cooms").Columns("AZ:BC").Hidden = False
Sheets("chkCooms").chk9.Value = False
End If
End Sub
Private Sub chkP10_Click()
If Me.chkP10.Value = True Then
Sheets("Cooms").Columns("BD:BG").Hidden = True
Sheets("chkCooms").chk10.Value = True
ElseIf Me.chkP10.Value = False Then
Sheets("Cooms").Columns("BD:BG").Hidden = False
Sheets("chkCooms").chk10.Value = False
End If
End Sub
Private Sub chkP11_Click()
If Me.chkP11.Value = True Then
Sheets("Cooms").Columns("BH:BK").Hidden = True
Sheets("chkCooms").chk11.Value = True
ElseIf Me.chkP11.Value = False Then
Sheets("Cooms").Columns("BH:BK").Hidden = False
Sheets("chkCooms").chk11.Value = False
End If
End Sub
Private Sub chkP12_Click()
If Me.chkP12.Value = True Then
Sheets("Cooms").Columns("BL:BO").Hidden = True
Sheets("chkCooms").chk12.Value = True
ElseIf Me.chkP12.Value = False Then
Sheets("Cooms").Columns("BL:BO").Hidden = False
Sheets("chkCooms").chk12.Value = False
End If
End Sub
Private Sub chkP13_Click()
If Me.chkP13.Value = True Then
Sheets("Cooms").Columns("BP:BS").Hidden = True
Sheets("chkCooms").chk13.Value = True
ElseIf Me.chkP13.Value = False Then
Sheets("Cooms").Columns("BP:BS").Hidden = False
Sheets("chkCooms").chk13.Value = False
End If
End Sub
Private Sub UserForm_Initialize()
Me.chkP1.Value = Sheets("chkCooms").chk1.Value
Me.chkP2.Value = Sheets("chkCooms").chk2.Value
Me.chkP3.Value = Sheets("chkCooms").chk3.Value
Me.chkP4.Value = Sheets("chkCooms").chk4.Value
Me.chkP5.Value = Sheets("chkCooms").chk5.Value
Me.chkP6.Value = Sheets("chkCooms").chk6.Value
Me.chkP7.Value = Sheets("chkCooms").chk7.Value
Me.chkP8.Value = Sheets("chkCooms").chk8.Value
Me.chkP9.Value = Sheets("chkCooms").chk9.Value
Me.chkP10.Value = Sheets("chkCooms").chk10.Value
Me.chkP11.Value = Sheets("chkCooms").chk11.Value
Me.chkP12.Value = Sheets("chkCooms").chk12.Value
Me.chkP13.Value = Sheets("chkCooms").chk13.Value
End Sub
I hope this all makes sense and that someone is able to assist me in this matter. If you need further explanation then please do not hesitate to ask. Thank you very much for your assistance.
Check the name of your userform its probably spelt incorrectly
For information about the error check this amazing description

Microsoft Word VBA multiple addresses - text box

Apologies in advance if this is already a question.
I've developed a user form to auto populate some of the letters we send to stakeholders. I currently have an address section in the userform - textboxstreet textboxsuburb etc.
User form
in certain circumstances I need to have:
Address A - the address we are sending the letter to
and
Address B - the address we sent the letter to previously
For example:
John Smith
15 Madeup Street
Faketown Australia
this is a follow up letter to advise we have sent your previous letter to 33 Fake Place Nowhere Australia.
My conclusion is that I obviously need an Address A section and an Address B section to break the addresses up. Is there a way though - if address a and address b are the same, that address a populates at the bookmarks set for Address B?
eg:
If address' are different:
(bookmarkaddressA) = textboxaddressA
(bookmarkaddressB) = textboxaddressB
If address' are the same:
(bookmarkaddressA) = textboxaddressA
(bookmarkaddressB) = textboxaddressA
Ideally I would like it to function like the
"is the postal address the same as the residential address?" checkbox - and just grey out/lock textboxaddressb and fill the info from textboxaddressa
Any suggestions welcome.
full code:
Option Explicit
Private Sub CheckBox1_Click()
If (CheckBox1.Value = True) Then TextBoxStreet2 = TextBoxStreet
If (CheckBox1.Value = True) Then TextBoxSuburb2 = TextBoxSuburb
If (CheckBox1.Value = True) Then TextBoxPostcode2 = TextBoxpostcode
If (CheckBox1.Value = True) Then ComboBoxState2 = ComboBoxState
If (CheckBox1.Value = False) Then TextBoxStreet2 = Null
If (CheckBox1.Value = False) Then TextBoxSuburb2 = Null
If (CheckBox1.Value = False) Then TextBoxPostcode2 = Null
If (CheckBox1.Value = False) Then ComboBoxState2 = Null
End Sub
Private Sub ComboBoxTitle_Change()
End Sub
Private Sub CommandButtonCancel_Click()
Unload Me
End Sub
Private Sub CommandButtonClear_Click()
TextBoxFN.Value = Null
TextBoxGN.Value = Null
ComboBoxState.Value = Null
ComboBoxTitle.Value = Null
TextBoxStreet.Value = Null
TextBoxSuburb.Value = Null
TextBoxpostcode.Value = Null
TextBoxCD.Value = Null
TextboxMPN.Value = Null
TextBoxMPDD.Value = Null
TextBoxNPN.Value = Null
TextBoxNPDD.Value = Null
ComboBoxState2.Value = Null
TextBoxStreet2.Value = Null
TextBoxSuburb2.Value = Null
TextBoxPostcode2.Value = Null
CheckBox1.Value = False
End Sub
Private Sub CommandButtonOk_Click()
Application.ScreenUpdating = False
With ActiveDocument
.Bookmarks("Title").Range.Text = ComboBoxTitle.Value
.Bookmarks("GN").Range.Text = TextBoxGN.Value
.Bookmarks("FN").Range.Text = TextBoxFN.Value
.Bookmarks("FN2").Range.Text = TextBoxFN.Value
.Bookmarks("Street").Range.Text = TextBoxStreet.Value
.Bookmarks("Suburb").Range.Text = TextBoxSuburb.Value
.Bookmarks("State").Range.Text = ComboBoxState.Value
.Bookmarks("PostCode").Range.Text = TextBoxpostcode.Value
.Bookmarks("Street2").Range.Text = TextBoxStreet2.Value
.Bookmarks("Suburb2").Range.Text = TextBoxSuburb2.Value
.Bookmarks("State2").Range.Text = ComboBoxState2.Value
.Bookmarks("PostCode2").Range.Text = TextBoxPostcode2.Value
.Bookmarks("CD").Range.Text = TextBoxCD.Value
.Bookmarks("MPN").Range.Text = TextboxMPN.Value
.Bookmarks("MPN2").Range.Text = TextboxMPN.Value
.Bookmarks("MPN3").Range.Text = TextboxMPN.Value
.Bookmarks("MPN4").Range.Text = TextboxMPN.Value
.Bookmarks("MPN5").Range.Text = TextboxMPN.Value
.Bookmarks("MPDD").Range.Text = TextBoxMPDD.Value
.Bookmarks("NPN").Range.Text = TextBoxNPN.Value
.Bookmarks("NPDD").Range.Text = TextBoxNPDD.Value
End With
Application.ScreenUpdating = True
Unload Me
End Sub
Private Sub UserForm_Initialize()
With ComboBoxState
.AddItem "QLD"
.AddItem "NSW"
.AddItem "ACT"
.AddItem "VIC"
.AddItem "TAS"
.AddItem "SA"
.AddItem "WA"
.AddItem "NT"
End With
With ComboBoxTitle
.AddItem "Mr"
.AddItem "Mrs"
.AddItem "Miss"
.AddItem "Ms"
End With
lbl_Exit:
Exit Sub
End Sub
Private Sub TextBoxMPN_Change()
TextboxMPN = UCase(TextboxMPN)
End Sub
Private Sub TextBoxNPN_Change()
TextBoxNPN = UCase(TextBoxNPN)
End Sub
Private Sub TextBoxFN_Change()
TextBoxFN = UCase(TextBoxFN)
End Sub
Since you asked, this is what i might have done (some code not included for clarity):
'disable "address B" controls is user selects to use same address for both
Private Sub CheckBox1_Click()
Dim en As Boolean
en = Not CheckBox1.Value
EnableControls Array(TextBoxStreet2, TextBoxSuburb2, _
ComboBoxState2, TextBoxPostcode2), en
End Sub
'utility sub: enable/disable controls
Private Sub EnableControls(cons, bEnable As Boolean)
Dim con
For Each con In cons
With con
.Enabled = bEnable
.BackColor = IIf(bEnable, vbWhite, RGB(200, 200, 200))
End With
Next con
End Sub
Private Sub CommandButtonOk_Click()
Dim useAforB As Boolean
useAforB = CheckBox1.Value
Application.ScreenUpdating = False
With ActiveDocument
'....
.Bookmarks("Street").Range.Text = TextBoxStreet.Value
.Bookmarks("Suburb").Range.Text = TextBoxSuburb.Value
.Bookmarks("State").Range.Text = ComboBoxState.Value
.Bookmarks("PostCode").Range.Text = TextBoxpostcode.Value
.Bookmarks("Street2").Range.Text = IIf(useAforB, _
TextBoxStreet.Value, TextBoxStreet2.Value)
.Bookmarks("Suburb2").Range.Text = IIf(useAforB, _
TextBoxSuburb.Value, TextBoxSuburb2.Value)
.Bookmarks("State2").Range.Text = IIf(useAforB, _
ComboBoxState.Value, ComboBoxState2.Value)
.Bookmarks("PostCode2").Range.Text = IIf(useAforB, _
TextBoxpostcode.Value, TextBoxPostcode2.Value)
'...
End With
Application.ScreenUpdating = True
Unload Me
End Sub

VBA: Prevent _Click Event from Triggering at Value Change

I have been had this issue in mind for months and it remains unresolved after so much research. I'm working with Excel Checkboxes and trying to make the system foolproof whereas "if A & B cannot occur together, if A is clicked and you click B, then the macro unclicks A for you".
However, the issue I'm running into is that this starts (as shown in my code below) an infinite loop,
The first Sub:
Private Sub CheckBoxD11_Click()
If CheckBoxD12.Value = True Then
CheckBoxD12.Value = False
Worksheets("Dynamic_Parking_Sheet").Range("D9").Interior.ColorIndex = 20
CheckBoxD11.Value = True
Worksheets("Dynamic_Parking_Sheet").Range("B8:E8").Interior.ColorIndex = 2
End If
TextBox1_Change
TextBox2_Change
If CheckBoxD11.Value = True Then
Worksheets("Dynamic_Parking_Sheet").Range("B9:E9").Interior.Color = RGB(221, 221, 221)
Worksheets("Dynamic_Parking_Sheet").Range("D8").Interior.ColorIndex = 4
Else
Worksheets("Dynamic_Parking_Sheet").Range("B9:E9").Interior.ColorIndex = 20
Worksheets("Dynamic_Parking_Sheet").Range("D8").Interior.ColorIndex = 2
End If
End Sub
.. and the second Sub:
Private Sub CheckBoxD12_Click()
If CheckBoxD11.Value = True Then
CheckBoxD11.Value = False
Worksheets("Dynamic_Parking_Sheet").Range("D8").Interior.ColorIndex = 2
CheckBoxD12.Value = True
Worksheets("Dynamic_Parking_Sheet").Range("B9:E9").Interior.ColorIndex = 20
End If
TextBox1_Change
TextBox2_Change
If CheckBoxD12.Value = True Then
Worksheets("Dynamic_Parking_Sheet").Range("B8:E8").Interior.Color = RGB(221, 221, 221)
Worksheets("Dynamic_Parking_Sheet").Range("D9").Interior.ColorIndex = 4
Else
Worksheets("Dynamic_Parking_Sheet").Range("B8:E8").Interior.ColorIndex = 2
Worksheets("Dynamic_Parking_Sheet").Range("D9").Interior.ColorIndex = 20
End If
End Sub
I tried working a bit with public flags, but the issue persisted.
Any advice?
Thank you,
~Deut
When you want checkboxes to uncheck each other, try simplifying your code to something like this:
CheckBoxD12.Value = Not CheckBoxD11.value
It would work quite well and there should be no loops.
Or something like this, made simple:
Private Sub chb_A_Click()
If chb_A Then chb_B = False
End Sub
Private Sub chb_B_Click()
If chb_B Then chb_A = False
End Sub
The idea here is that it only checks for being checked to allow the option for both checkboxes to be unchecked.

VBA Variable as CommandButton#

I'm rewriting some code and had a thought, but can't seem to get my syntax right to execute it properly. I want to use a for loop to populate an array of commandbuttons as well as control their visibility. I just need help with my syntax to define which CommandButton number I'm working on in the loop. For instance, CommandButton1, CommandButton2, etc.
Public Sub LoadLots(sName As String, streamLots() As String)
Label1.Caption = sName
For o = 1 To 9
If streamLots(o) <> "" Then
CommandButton& o &.Caption = streamLots(o)
CommandButton& o & .Visable = True
Else
CommandButton& o & .Visable = False
End If
Next
End Sub
Use the Userform.Controls collection to reference the commandbuttons by name.
Public Sub LoadLots(sName As String, streamLots() As String)
Dim btn As MSForms.CommandButton
Label1.Caption = sName
For o = 1 To 9
Set btn = Me.Controls("CommandButton" & o)
If streamLots(o) <> "" Then
btn.Caption = streamLots(o)
btn.Visible = True
Else
btn.Visible = False
End If
Next
End Sub

DblClick call in VBA - close on double click without running function

Good Afternoon,
Bear with me, I am new to VBA. I have a Sub that opens a text box when its double clicked, not only do I want it to open the text box (expands it), i also want it to run a sub called EMSpull. This all works perfectly except for the fact I want to then double click to close the textbox without running EMSpull again.
Also, can someone explain "Control", especially for this situation (i didnt write the adjustheight )
Code is below
Private Sub txtEMS_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call AdjustHeight(txtEMS, lblEMS)
Call EMSpull
End Sub
Public Sub AdjustHeight(cControl As Control, cLabel As Control)
On Error GoTo errhand
If bExpandedMode = False Then
dOldTop = cControl.Top
dOldLeft = cControl.Left
dOldWidth = cControl.Width
dOldHeight = cControl.Height
cControl.Top = lblDescription.Top + 50
cControl.Width = cControl.Width * 2
cControl.Height = 500
cControl.Left = lblResults.Left
bExpandedMode = True
Call HideAllTxt(cControl)
lblDescription.Visible = True
lblDescription.Caption = cLabel.Caption
If Len(cControl.Text) > 2 Then
cControl.CurLine = 0
End If
Else
bExpandedMode = False
Call ShowAllTxt
lblDescription.Visible = False
cControl.Top = dOldTop
cControl.Left = dOldLeft
cControl.Width = dOldWidth
cControl.Height = dOldHeight
End If
Exit Sub
errhand:
Resume Next
End Sub
I'm assuming you have a global boolean named bExpandedMode at the top of the subs? If so this should work fine:
Private Sub txtEMS_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call AdjustHeight(txtEMS, lblEMS)
if bExpandedMode = true then Call EMSpull 'Calls it only when it expanded in AdjustHeight
End Sub
Public Sub AdjustHeight(cControl As Control, cLabel As Control)
On Error GoTo errhand
If bExpandedMode = False Then
dOldTop = cControl.Top
dOldLeft = cControl.Left
dOldWidth = cControl.Width
dOldHeight = cControl.Height
cControl.Top = lblDescription.Top + 50
cControl.Width = cControl.Width * 2
cControl.Height = 500
cControl.Left = lblResults.Left
bExpandedMode = True
Call HideAllTxt(cControl)
lblDescription.Visible = True
lblDescription.Caption = cLabel.Caption
If Len(cControl.Text) > 2 Then
cControl.CurLine = 0
End If
Else
bExpandedMode = False
Call ShowAllTxt
lblDescription.Visible = False
cControl.Top = dOldTop
cControl.Left = dOldLeft
cControl.Width = dOldWidth
cControl.Height = dOldHeight
End If
Exit Sub
errhand:
Resume Next
End Sub
Basically if that boolean exists and is used like I think it is, it just check whether the box is expanded right now or not. When it's not, the boolean is False, and AdjustHeight expands it, then turns it to true. Conversely when it is set to True, it closes it instead, and sets it to False.
So my fix just checks that same boolean and only runs it 1 way (when it just expanded)