VBA Variable as CommandButton# - vba

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

Related

Simplify toggle button change BackColor Code 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.

Include loop counter in object name [VBA]

Basically I wrote a code, which is to be used in userform. The thing is that userform is created by other macro (amount of checkboxes differs, depends how many words string strNamn contains, that is why userform must be created by macro).
I would like to, somehow, include loop counter in the line:
If UserForm1.CheckBox0.Value = True Then
to make it like this:
If UserForm1.CheckBox(i).Value = True Then
But it obviously doesn't work like this :(
Any suggestion how to declare checkbox to include the counter in the line?
Code in UserForm1 to execute macro looks like:
Private Sub cmd_1_Click()
Call clicker
End Sub
Macro code:
Sub clicker()
Dim strNamnOK As String
Dim strNamn As String
Dim strNamnA() As String
strNamn = "one, two, three, four"
strNamnA = Split(strNamn, ", ")
Dim intAmount As Integer
intAmount = UBound(strNamnA)
strNamnOK = ""
For i = 0 To intAmount
If UserForm1.CheckBox0.Value = True Then
strNamnOK = strNamnOK & " " & strNamnA(i)
End If
Next
strNamnOK = Left(strNamnOK, 12)
MsgBox strNamnOK
End Sub

Excel Vba click radio button with application.caller

I have a macro which run function (clear each named range depend ot application.caller.name) if radio button was clicked
Sub Clear_Click()
Dim s, f, arr
s = ActiveSheet.Shapes(Application.Caller).Name
arr = Array("NamedArray1", "NamedArray2", "NamedArray3", "NamedArray4")
Select Case s
Case "Clear7"
For i = LBound(arr) To UBound(arr)
ThisWorkbook.Worksheets("info").Range(arr(i)).value = ""
Next i
Case Else
f = arr(Right(s, 1) - 1)
ThisWorkbook.Worksheets("info").Range(f).value = ""
End Select
End Sub
It works ok.
Now i need to click Clear7 radio button from other function
So if i do
Sub test()
Application.Run ActiveSheet.Shapes("Clear7").OnAction
End Sub
I got error on s = ActiveSheet.Shapes(Application.Caller).Name as there are no Application.Caller i think.
So how to click radio button from other function?
If you're using Application.Caller but you want to run the code without someone needing to click the button then here's how you can do it.
NOTE: since Clear_Click has an argument, it won't show up in the "assign macro" list when attaching it to a button, but you can type its name directly in the box and that will work fine.
Sub Clear_Click(Optional callerName As String = "")
Dim s, f, arr, cn As String, i
Dim sht As Worksheet
cn = IIf(Len(callerName) > 0, callerName, Application.Caller)
'Debug.Print cn
Set sht = ThisWorkbook.Worksheets("info")
arr = Array("NamedArray1", "NamedArray2", "NamedArray3", "NamedArray4")
Select Case cn
Case "Clear7"
For i = LBound(arr) To UBound(arr)
sht.Range(arr(i)).Value = ""
Next i
Case Else
f = arr(Right(s, 1) - 1)
sht.Range(f).Value = ""
End Select
End Sub
Sub test()
ClickIt "Clear7"
End Sub
'run a macro attached to a shape and pass its name as a parameter
Sub ClickIt(sName As String)
Application.Run ActiveSheet.Shapes(sName).OnAction, sName
End Sub

How to create a loop on e.g.,. TextBoxes' name placed within the Worksheet in Excel?

I have TextBoxes on UserForm and in Excel File (unfortunately).
I can do the loop on those in UserForm, and it works perfectly:
Dim txt(1 To 20) As String
txt(3)=("txtCompany")
txt(4)=("txtDataSource")
....
For i = 1 To 20
If frmInfo.Controls(txt(i)).Value <>
Worksheets(SheetNameDataBaze).Cells(ERow, i).Value Then ....
However, there is a huge problem with controls placed on the worksheet.
I tried:
Worksheets(SheetNameDataBaze).Controls(txt(i)).Value
Worksheets(SheetNameDataBaze).TextBox(txt(i)).Value
Worksheets(SheetNameDataBaze).OLEObjects(txt(i)).Value
Worksheets(SheetNameDataBaze).Shapes(txt(i)).Value
Worksheets(SheetNameDataBaze).txt(i).Value
nothing worked.
How should I define it?
It would be much easier then preparing the if statement for each TextBox.
I'm assuming that your textboxes on the worksheet are ActiveX controls and not forms controls. If so, then does this work for you?
Sub ReferToTextboxes()
Dim txt As MSForms.TextBox
Dim o As OLEObject
For Each o In Sheet1.OLEObjects
If o.progID = "Forms.TextBox.1" Then
Set txt = o.Object
'now you can refer to txt and do what you need
Debug.Print txt.Text
End If
Next o
End Sub
I finally used:
Private Sub FunctionalProgramNew()
Dim bLoop As Double
Dim eLoop As Double
bLoop = 8
eLoop = 13
Dim txt(8 To 13) As String
txt(8) = ("txtFuel_1")
txt(9) = ("txtFuel_2")
txt(10) = ("txtFuel_3")
txt(11) = ("txtProduct_1")
txt(12) = ("txtProduct_2")
txt(13) = ("txtProduct_3")
Dim txtBox(8 To 13) As MSForms.TextBox
For i = bLoop To eLoop
Set txtBox(i) = Worksheets(SheetNameModel).OLEObjects(txt(i)).Object
Next i
For i = bLoop To eLoop
If txtBox(i).Value <> CStr(Cells(ActiveCell.row, ActiveCell.Column + i - 2).Value) Then
MsgBox ("Error code: " & txt(i))
End If
Next i
End Sub

VBA to change slicer selection current selected item

The below behaves quite strangely.
It's aim is to leave the slicer with only the item specified (in this case "Smith") with all other names not selected.
Most of the time it works but sometimes more than one item will be left selected.
What is wrong with the below and how do I achieve the required behaviour?
Sub myRoutine()
unselectAllBut "Slicer_InitialAcc_Surname", "me"
End Sub
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim si As Object
For Each si In ActiveWorkbook.SlicerCaches(slicerName).SlicerItems
si.Selected = (si.Caption = newSelection)
Next si
End Sub
Second attempt which doesn't work either:
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim i As Integer
With ActiveWorkbook.SlicerCaches(slicerName)
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = (.SlicerItems(i).Caption = newSelection)
Next i
End With
End Sub
Maybe the data is causing the problem. It looks like the following:
EDIT
The following seems to work. I select all items first which seems like over-kill:
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim i As Integer
With ActiveWorkbook.SlicerCaches(slicerName)
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = True
Next i
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = (.SlicerItems(i).Caption = newSelection)
Next i
End With
End Sub
A bit faster way:
first set the new selection
second clear all others
Public Sub unselectAllBut(slicerName As String, newSelection As String)
Dim i As Integer
With ActiveWorkbook.SlicerCaches(slicerName)
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Caption = newSelection Then .SlicerItems(i).Selected = True: Exit For
Next i
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Selected And .SlicerItems(i).Caption <> newSelection Then .SlicerItems(i).Selected = False
Next i
End With
End Sub