I've got VBA code written to make a hidden tab appear based on a combo box selection. There are seven options in the combo box that each corresponds to seven hidden tabs in the frame.
Private Sub CBO_EntryType_Change()
Dim iPage As Integer
If Me.CBO_EntryType.Value = "Abstracts" Then
iPage = 1
ElseIf CBO_EntryType.Value = "Awards" Then
iPage = 2
ElseIf CBO_EntryType.Value = "Career Fairs" Then
iPage = 3
ElseIf CBO_EntryType.Value = "Editorials" Then
iPage = 4
ElseIf CBO_EntryType.Value = "Rankings" Then
iPage = 5
ElseIf CBO_EntryType.Value = "Tradeshows" Then
iPage = 6
ElseIf CBO_EntryType.Value = "Social Media" Then
iPage = 7
End If
Me.MultiPage1.Pages(iPage).Visible = True
End Sub
What I seem to be having trouble with is, how do I make sure the other tabs are hidden? Since people can only click one option in the combo box, but they might click one by mistake, and then click the correct one. Only one tab should be visible based on the selected item in the combo box. The other six should be hidden.
I'm thinking a For-Each-Next loop at the end of the sub that disables any tab that doesn't match the iPage variable but I'm having difficulty figuring out how to address the frame and pages in the For Each Next loop. What would the variable declaration be?
Untested, so may need minor tweaks...
Private Sub CBO_EntryType_Change()
Dim iPage, arrPages, x As Long
arrPages = Array("Abstracts", "Awards", "Career Fairs", "Editorials", _
"Rankings", "Tradeshows", "Social Media")
'find the index in the array...
iPage = Application.Match(Me.CBO_EntryType.Value, arrPages, 0)
'if got a match then loop over the pages and show/hide
If Not IsError(iPage) Then
For x = 0 To Me.MultiPage1.Pages.Count-1
Me.MultiPage1.Pages(x).Visible = ((x+1) = iPage)
Next x
End If
End Sub
EDIT - #jstola and I think alike...
Below code assumes the Caption of the Pages in the Multipage reflects the list in CBO_EntryType:
Private Sub CBO_EntryType_Change()
Dim iPage As Long
For iPage = 0 To Me.MultiPage1.Pages.Count - 1
With Me.MultiPage1.Pages(iPage)
.Visible = (.Caption = CBO_EntryType.Value)
End With
Next
End Sub
Related
I have a Data Entry Userform that works but now I want to replicate it I need 36 fields in total (144 items not including buttons)
for an example
Field 1 will consist of a TextBox and 3 labels. (Data Entry, Title, Bottom Border and FieldRequired label.
What I want to do is to generate the above with names like Txt1,Txt2,Txt3.... Title1, Title2, Title3, Bdr1,Bdr2,Bdr3, Fr1,Fr2,Fr3 and for some I need to create Listbox1,Listbox2 and Listbox3 inside of frames 1 2 and 3 but this I can do manually.
I want to separate them so 4 fields across and 9 fields down.
Is there an easy solution to doing this or just doing it manually?
I can sort of do this using the below and then just doing this 4 times and adding 80 to the left
I would then need do to the same for the other fields and apply the events to them and fonts/font sizes etc but I cant figure out how to use events against them.
Sub addLabel()
frmUserAdd.Show vbModeless
Dim lblid As Object
Dim lblc As Long
For lblc = 1 To 9
Set lblid = frmUserAdd.Controls.Add("Forms.Label.1", "Alert" & lblc, True)
With lblid
.Caption = "*Field Required" & lblc
.Left = 10
.Width = 60
.Top = 30 * lblc
End With
Next
end sub
Please, test the next scenario:
Insert a class module, name it "clsTbox" and copy the next code inside it:
Option Explicit
Public WithEvents newTBox As MSForms.TextBox
Private Sub newTBox_Change()
If Len(newTBox.Text) > 3 Then 'it do something for 4 entered digits:
Select Case CLng(Right(newTBox.name, 1))
Case 1, 3
MsgBox newTBox.name & " changed (" & newTBox.Text & ")"
Case 2, 4
MsgBox newTBox.name & " changed its text"
Case Else
MsgBox newTBox.name & " Different text..."
End Select
End If
End Sub
Insert a Userform and copy the next code in its code module:
Option Explicit
Private TBox() As New clsTBox
Private Sub UserForm_Initialize()
Dim i As Long, txtBox01 As MSForms.TextBox, leftX As Double, tWidth As Double, k As Long
Const txtBName As String = "Txt"
leftX = 20: tWidth = 50
ReDim TBox(10) 'use here the maximum number of text boxes you intend creating
For i = 1 To 5
Set txtBox01 = Me.Controls.Add("Forms.TextBox.1", txtBName & i)
With txtBox01
.top = 10
.left = leftX: leftX = leftX + tWidth
.width = tWidth
.Text = "something" & i
End With
Set TBox(k).newTBox = txtBox01: k = k + 1
Next i
ReDim Preserve TBox(k - 1) 'keep only the loaded array elements
End Sub
Now, show the form and play with text in the 5 newly created text boxes.
You can show one of its instances in the next way:
a) Name it "frmTxtBEvents"
b) Use the next Sub:
Sub ShowTheForm()
Dim frm As New frmTxtBEvents
frm.Show vbModeless
End Sub
When enter 4 characters, according to the last text box name digit their Change event will show specific message boxes...
If something not clear enough, do not hesitate to ask for clarifications.
But it is late in my country and (today) I will be available for no more than half an hour.
So I have a form called "Print_Form" that has 20 checkboxes that upon form initialization take on the sheet names of the first 20 sheets of my workbook.
(no issue with the UserForm_Initialize() sub, this works fine)
Private Sub UserForm_Initialize()
CheckBox1.Caption = Sheets(1).Name
CheckBox2.Caption = Sheets(2).Name
CheckBox3.Caption = Sheets(3).Name
CheckBox4.Caption = Sheets(4).Name
CheckBox5.Caption = Sheets(5).Name
CheckBox6.Caption = Sheets(6).Name
CheckBox7.Caption = Sheets(7).Name
CheckBox8.Caption = Sheets(8).Name
CheckBox9.Caption = Sheets(9).Name
CheckBox10.Caption = Sheets(10).Name
CheckBox11.Caption = Sheets(11).Name
CheckBox12.Caption = Sheets(12).Name
CheckBox13.Caption = Sheets(13).Name
CheckBox14.Caption = Sheets(14).Name
CheckBox15.Caption = Sheets(15).Name
CheckBox16.Caption = Sheets(16).Name
CheckBox17.Caption = Sheets(17).Name
CheckBox18.Caption = Sheets(18).Name
CheckBox19.Caption = Sheets(19).Name
CheckBox20.Caption = Sheets(20).Name
End Sub
Where I am running into issues is in the following sub routine when the user clicks the print button in the form. The intention behind this button is to print all the sheets that the user has selected (i.e. the sheets that had their corresponding checkbox checked by the user). Currently, when I select multiple checkboxes and then click on the print button I get the following error; "Run-Time error '9': Subscript out of range.
Private Sub cmdPrint_Click()
Dim i As Integer
Dim cb As MSForms.Control
Dim SheetArray() As String
i = 0
'Search form for a checkbox
For Each cb In Me.Controls
i = i + 1
ReDim Preserve SheetArray(i)
'If the control is a checkbox
If TypeName(cb) = "CheckBox" Then
'and the checkbox is checked
If cb.Value = True Then
'Add the sheet to the sheet array (sheet name string was already added to the checkbox property caption; see UserForm_initialize)
SheetArray(i) = cb.Caption
End If
End If
Next cb
'Print Sheet Array
Sheets(SheetArray()).PrintOut
Unload Me
End Sub
If anyone has any ideas that would help me get this to work I would be very appreciative. Thank you in advance. :)
Try this:
Private Sub UserForm_Initialize()
Dim i As Long
For i = 1 To 20 'less typing....
Me.Controls("CheckBox" & i).Caption = Sheets(i).Name
Next i
End Sub
Private Sub cmdPrint_Click()
Dim i As Integer, s As String, sep
For i = 1 To 20
With Me.Controls("CheckBox" & i)
If .Value Then
s = s & sep & .Caption
sep = "," 'add delimiter after first item
End If
End With
Next i
Sheets(Split(s, ",")).PrintOut
Unload Me
End Sub
Im working with a workbook with many sheets and im using a UserForm with more than 150 Combobox and arround 200 Labels.
I want to set the charasteristic and design of the comboboxes in only one and i want to be applied in a lot of them, so i do not want to repeat the code hundreds of times.
How should i do? i ve been reading but i cant match the examples with mine.
This is the wrong code:
Private Sub ComboBox7_Change()
Dim ws2 As Worksheet: Set ws2 = Sheets("C. VfM Questionnaire ")
Dim i, p As Integer
For i = 7 To 31
If Controls("ComboBox" & i).Value = "Yes" Then
ws2.Range("G7") = 4
Me.Controls("Label" & i).BackColor = RGB(146, 208, 80)
ElseIf Controls("ComboBox" & i).Value = "No" Then
ws2.Range("G7") = 4
Me.Controls("Label" & i).BackColor = RGB(255, 33, 26)
ElseIf Controls("ComboBox" & i).Value = "Not Applicable" Then
ws2.Range("G7") = 4
Me.Controls("Label" & i).BackColor = RGB(255, 204, 0)
End If
Next i
End Sub
Also i do not know how to trigger the code? is it in te user form initalize or in a module? Im so newbee as you can see!
Thanks a lot in advance.
If I understood your question correctly, you have a lot of ComboBoxes, and you want to change their style. But instead of changing all of them, you want to change one of them, and then have the form apply this style to all of them, right?
So we pick a box to be the "style guide" and assign that to a variable.
Then we loop though all the ComboBoxes in the Form, and apply the traits.
As for how to trigger it, UserForm initalize would certainly work.
This code for example:
Private Sub UserForm_Initialize()
Dim origin As ComboBox, c As Variant
Set origin = Me.ComboBox1 'Combobox to copy style from
For Each c In Me.Controls
If TypeName(c) = "ComboBox" Then
c.BackColor = origin.BackColor
c.BackStyle = origin.BackStyle
c.BorderColor = origin.BorderColor
c.BorderStyle = origin.BorderStyle
c.ForeColor = origin.ForeColor
End If
Next
End Sub
Changes this:
To this:
Applying the style of the first box, in the top left corner, called ComboBox1
So I've been working on a spreadsheet that I'm going to use as a template for several more spreadsheets and I've gotten most of the template finished but I would like to add a feature involving the spinbar.
Currently I have 100 input buttons displayed and I know that I will not need 100 buttons for all the possible uses of the template, I just included 100 as a max.
I am looking to add a 1 - 100 spinbar so that it will automatically show/hide buttons depending on the number associated with the spinbar.
I should have no issues figuring out how to hide the buttons or show the buttons, but I cannot figure out the proper code to have buttons visible between 1 - 100.
Sub LocNum ()
Dim i As Integer
Dim n As Integer
n = Worksheets(1).Cell
For i = 1 To n
That's about as far as I can get, so if n is equal to 37 it should only have 37 buttons visible.
I'm getting my code from something I typed up previous before I took a break from it for quite awhile, here is the code.
Sub Populate()
Dim t As Integer
Dim i As Integer
Dim a As String
t = ActiveWorkbook.Sheets.Count - 1
i = 0
For i = 2 To t
a = i - 1
If (ActiveSheet.Shapes("" + "btn.index" & i).Visible = True) Then
ActiveSheet.Shapes("" + "btn.index" & i).Select
Selection.OnAction = "" + "Location" & a + ""
Selection.Characters.Text = ActiveWorkbook.Worksheets(i).Name
Else
Exit Sub
End If
Next i
End Sub
Any help would be appreciated.
Not entirely sure your workflow, but this can help you show/hide the buttons either based on the index (I don't recommend) or the name of the button. You just call this Sub providing the number of buttons to show, rest (index/name higher than the number) will be hidden.
I will let you play with the OnAction.
Option Explicit
Sub ShowButtonsUpTo(ByVal ButtonCount As Long)
Dim oButton As Button ' or Object
For Each oButton In Worksheets(1).Buttons
With oButton
' Based on Index (not recommend):
.Visible = (.Index <= ButtonCount)
' Based on Name (button name):
If InStr(1, .Name, "btn.index", vbTextCompare) = 1 Then
.Visible = (CLng(Replace(.Name, "btn.index", "")) <= ButtonCount)
End If
End With
Next oButton
End Sub
I want my worksheet to interact with the user input through the dropdown. Basically I need to copy and paste columns of data according to the input via the dropdown button.
This is my code
Sub DropDown84_Change()
If ActiveSheet.DropDowns("Drop Down 84").Value = 1 Then
Sheets("data").Range("N28:N30").Value = Sheets("data").Range("E48:B50").Value
ElseIf ActiveSheet.DropDowns("Drop Down 84").Value = 2 Then
Sheets("data").Range("N28:N30").Value = Sheets("data").Range("F48:F50").Value
ElseIf ActiveSheet.DropDowns("Drop Down 84").Value = 3 Then
Sheets("data").Range("N28:N30").Value = Sheets("data").Range("G48:G50").Value
ElseIf ActiveSheet.DropDowns("Drop Down 84").Value = 4 Then
Sheets("data").Range("N28:N30").Value = Sheets("data").Range("H48:H50").Value
Else: Sheets("data").Range("N28:N30").Value = Sheets("data").Range("J48:J50").Value
End If
End Sub
I receive a message
"Runtime error 1004, Unable to get the DropDowns property of the worksheet class"
Please help,
I hope you use ActiveX for this:
Sub ComboBox84_Change()
Select Case ActiveSheet.ComboBox84.Value
Case 1
Sheets("data").Range("N28:N30").Value = Sheets("data").Range("E48:B50").Value
Case 2
Sheets("data").Range("N28:N30").Value = Sheets("data").Range("F48:F50").Value
Case 3
'-- do for all of your cases--
End Select
End Sub