Userform listbox that depends on another listbox - vba

I have been looking in the internet for the answer to this, but mostly people say to use data validation, which doesn't really solve my problem. What I'm trying to do is, lets say that I have ListBox1, which has 3 values (red, blue, green) and there's another listbox (ListBox2) where I want value of a list from a worksheet to appear depending on the answer of the first ListBox. For example: I select red from listbox1 and then I want to have the options from the list "red" (apple, coke,fire) in listbox2.
I would greatly appreciate some help in this. Thanks

you could use something like follows (adapt it as per your needs):
Private Sub ListBox1_Click()
With Me.ListBox2
.Clear
.List = Application.Transpose(GetColorItemsRange(Me.ListBox1.value)) 'fill referenced listbox with values from the range returned by GetColorItemsRange function
End With
End Sub
Function GetColorItemsRange(colorValue As String) As Range
With Worksheets("ColorItames") ' change "ColorItames" with actual name of your worksheet with items associated to colors
With .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)).Find(what:=colorValue, LookIn:=xlValues, lookat:=xlWhole) 'find and reference the referenced sheet row 1 cell matching the passed value
Set GetColorItemsRange = .Parent.Range(.Cells.Offset(1), .Cells.End(xlDown)) 'return the range ranging from referenced range down to last not empty cell before first empty cell
End With
End With
End Function

Data validation is the way to go. You would want to leverage some combination of VBA to adjust the range listbox2 is using after Listbox1 is updated. This is relatively easy if only 1 selection is used on listbox1.
Hopefully you just have one selection, so you could do the following code:
Private Sub ListBox1_Click()
If ListBox1.Selected(0) = True Then
'Selection is apple. Adjust DynamicRange name for A1:A3
ThisWorkbook.Names("DynamicRange").RefersTo = Range("A1:A3")
ElseIf ListBox1.Selected(1) = True Then
ThisWorkbook.Names("DynamicRange").RefersTo = Range("B1:B3")
ElseIf ListBox1.Selected(2) = True Then
ThisWorkbook.Names("DynamicRange").RefersTo = Range("C1:C3")
End If
End Sub
This is based on a setup that looks like this:
Here's what both listbox properties would look like:
If you want to download this classy template, click here.

Related

Need help, VBA, need the combobox to avoid entering a specific values

I have a list of data in a sheet from A1:A8 and i have a combobox1 in a userform. What i want is to avoid a user to input an invalid value in the combobox1 based on the lists of data in the sheet
Go to combobox properties and change Style from 0 - fmStyleDropDownCombo to 2 - fmStyleDropDownList
i think this is what you are searching:
https://msdn.microsoft.com/en-us/vba/access-vba/articles/combobox-beforeupdate-event-access
There you have a way to check the values with that you want, there is a example where you can replace it with your range of cells.
Edited (Nice point, i'll put the example here):
Private Sub Combobox_BeforeUpdate(Cancel As Integer)
For i = 1 to 8
If(Cells(i, 1).Value == Me.Combobox.Value)
Cancel = True
Me.Combobox.Undo
End If
Next i
End Sub
Cya.

Excel VBA Validation List set Default Value

I have worked out the following code (minus the Dim and Set section, but WS1 = Sheet1 and WS2 = Sheet2) that will set all 'Validation List' default values on my target Excel Worksheet to the first item in their referenced Tables:
'+++Work through the processing of the 'Validation Lists' in the Worksheet+++
For Each rngValList In WS1.Cells.SpecialCells(xlCellTypeAllValidation).Cells
With rngValList
If .Validation.Type = xlValidateList Then
'Process those that should be set as the first value in the list.
.Value = Range(Replace(.Validation.Formula1, "=", "")).Cells(1, 1)
End If
End With
Next rngValList
However, there is one Validation List on that same target page where I would like to set the default value to a different item contained in the list. I can do this by just separately calculating the item and then updating the cell where the Validation List values are selected, which works. But, what I'd really like to do is have the list (which is long) focus on the targeted default item, when the drop-down button is selected. Using this method, the first item in the drop-down list is still the focus of the list.
I tried modifying the code above to change the default value (probably in a way too complex change, but it worked), and it does select the correct value. But, the focus in the drop-down list is still on the first item in the list, when it is selected.
My modified code is as follows:
'+++Work through the processing of the 'Validation Lists' in the Worksheet+++
For Each rngValList In WS1.Cells.SpecialCells(xlCellTypeAllValidation).Cells
With rngValList
If .Validation.Type = xlValidateList Then
'If the Valdation List is Month End, then select the correct month date.
If .Validation.Formula1 = "=LUT_MonthEnd" Then
'Set the Default End Month value to the correct Month.
i = 0
For Each rngSMList In WS2.Range(TS).Cells
i = i + 1
With rngSMList
If rngSMList = WS2.Range(DS) Then
'Capture the counter at this point and exit to the rngValList Range Object.
GoTo EndMthStop
End If
End With
Next rngSMList
EndMthStop:
.Value = Range(Replace(.Validation.Formula1, "=", "")).Cells(i, 1)
Else
'Process those that should be set as the first value in the list.
.Value = Range(Replace(.Validation.Formula1, "=", "")).Cells(1, 1)
End If
End If
End With
This is not a big deal, as I am able to set the default value to the correct one, so things work fine as it is. But, it would be nice to have the default value selected be the one in focus when the drop-down list is selected, rather than always the first item in the list.
Conceptually, I guess what I need is a pointer to the correct default value in the target Table List.
Any suggestions on how this can be accomplished would be most appreciated.
Regards,
Wayne
This should get you started, along with my comments above. Paste the following code into the worksheet object (not a module).
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
Target.value = "Your Value"
End If
End Sub
The Sub Worksheet_SelectionChangeis an event that fires every time a new cell is selected.
Application.Intersect returns a range that represents the overlap between two ranges.
The example above assumes your list is in cell A1.
Target is the cell that was clicked on, so we set the value of the cell to whatever value you want selected in your list.
select the cell in which you have put the listitem.
the range for the listitem is "Opleiding"
in your VBA code:
selection.Value = Range("opleiding").Cells(2, 1)
the result is that the selected item of the listItem is the second item in the range "Opleiding"

Dynamic Range and one static Item to a ComboBox via VBA

I have this code:
With Sheet1.Shapes("comboBox1").ControlFormat
.ListFillRange = "namedRange"
.AddItem "1.Item"
End With
But after that, just "1.Item" is in my Combo-Box and the dynamic range don't appear at all.
How can I add one Item and my Range to the Combo-Box?
EDIT
The dynamic range would work if I delete .AddItem:
With Sheet1.Shapes("comboBox1").ControlFormat
.ListFillRange = "namedRange"
End With
My Question is if there is a possibility to combine those to not in a range, but rather separated from each other.
Thank you very much in advance for your answers...
If I understood your post correctly, you want to add another Item to the items in your "namedRange" and show all these items in your worksheet ComboBox (which is actually a drop-down in your worksheet).
(modify "Sheet2" to your sheet's name).
Sub PopulateCombo_fromArray()
Dim ComboArray As Variant
'clear Combo-Box from previous runs >> modify "Sheet2" to your sheet's name
Worksheets("Sheet2").Shapes("ComboBox1").ControlFormat.RemoveAllItems
' reading the NamedRange into a 1-dimension array
ComboArray = Application.Transpose(Range("namedRange").Value)
ReDim Preserve ComboArray(UBound(ComboArray))
' add another element to the array (outside the "namedRange")
ComboArray(UBound(ComboArray)) = "1.Item"
' populate "ComboBox1" with array
Worksheets("Sheet2").Shapes("comboBox1").ControlFormat.List = ComboArray
End Sub
Must you use "Shapes"?
if not, you can fill a combobox with a named range like this :
With Sheet1.ComboBox1
.List = Application.Transpose(Range("namedRange"))
.AddItem "1.Item"
End With

Adding combo box across multiple cells

I need to add combo box(ActiveX Control) or Data Validation as drop down list.
I have a range of 15 values like, high, low, medium,etc...
Have created named range called "priorityvalue".
I can create a dropdown list using combo box by adding named range under ListFillRange in the properties or data validation list by giving named range.
But my concern, I need to dropdown list for 58cells with same values mentioned above. Its tedious job to create combo box for all cells. Please suggest me better option here.
Data validation list serves the purpose. However, it makes user to scroll through dropdown list on each cell unlike combo box it has no input box..
Please suggest
Paste the below code in 'ThisWokbook'
Private Sub Workbook_Open()
Dim oItem As Object
For Each oItem In Worksheets(1).OLEObjects
If TypeName(oItem.Object) = "ComboBox" Then
If Len(oItem.Object.Value) > 0 Then
oItem.Object.Value = ""
End If
End If
Next
Set oItem = Nothing
End Sub
NOTE: There are caveats to this. Above code will reset all comboboxes in your worksheet (also, I've set the worksheet to the first worksheet in the workbook, you might want to make that dynamic). If you don't want it to reset all comboboxes and only do the ones you added via the function, you can use the name format to filter the ones you want to clear
Hope this helps
Try this:
Sub AddComboBoxToColumns(ByVal oRange As Excel.Range)
Dim oOLE As OLEObject
Dim oCell As Object
' Loop through all the cells in the range
For Each oCell In oRange.Cells
' Add ComboBox in each cell
With oCell
Set oOLE = .Parent.OLEObjects.Add("Forms.combobox.1")
oOLE.Top = .Top
oOLE.Left = .Left
oOLE.Width = .Width
oOLE.Height = .Height
oOLE.Name = "ComboBox" & .Address(False, False)
oOLE.Object.List = Array("Test1", "Test2")
End With
Next
Set oOLE = Nothing
End Sub
NOTE: Call the above function with the range of cells you want to add ComboBox to. You will have to change the Array to use the values you want (you can type them in there or give the range where your existing values are)

Searching and Returning bold values in VBA

I know that this probably isn't the most ideal way to to do this but just bear with me.
I have a document with a few tables on it. I'm using a userform to search the tables/sub-categories and return the relevant values. I want to select the sub categories with a range of option buttons on a userform, these will in turn set the range for the search function to look within. I also want to dynamically update the option buttons if a new table was to be added or anything along those lines.
The only thing that differentiates the title of a sub-category/table, and the items within it, is that the title of a sub-category/table is bold. So what I'm looking to do is search the first column of the spreadsheet and return the names of any entries in bold. These values are then used to set the names of the option buttons :).
The following function is my attempt at finding the text entities in column a that are in bold, returning them and setting each to an individual variable to be used in another function. The bold1 .... variables are all globally defined variables as I need them in another sub, as is the page variable which contains the relevant page to be used. Currently the code returns an error stating "variable or with block not set" and using the debugger I can see that bold1 .... and all the other boldx variables have no value set. Does anybody know whats going on/how to fix this function.
Thanks in advance :)
Sub SelectBold()
Dim Bcell As Range
For Each Bcell In Worksheets(Page).Range("A1:A500")
If Bcell.Font.Bold = True Then
Set bold1 = Bcell
End If
Next
End Sub
EDIT: I simplified the above function, to remove clutter and help narrow in on the issue. I want the above function to store the contents of the found cell (any cell in the document in bold at this stage) in the variable bold1
This will return an array of values from bold cells in column A of Page.
You can fill a combo or list box with theses values using their list property.
ComboBox1.List = getSubCategories("Sheet1")
Function getSubCategories(Page As String) As String()
Dim arrSubCategories() As String
Dim count As Long
Dim c As Range
With Worksheets(Page)
For Each c In .Range("A2", .Range("A" & Rows.count).End(xlUp))
If c.Font.Bold Then
ReDim Preserve arrSubCategories(count)
arrSubCategories(count) = c.Value
count = count + 1
End If
Next
End With
getSubCategories = arrSubCategories
End Function
you may find useful to have a Range returned with subcategories cells found:
Function SelectBold(Page As String, colIndex As String) As Range
With Worksheets(Page)
With .Range(colIndex & "1", .Cells(.Rows.Count, colIndex).End(xlUp)).Offset(, .UsedRange.Columns.Count)
.FormulaR1C1 = "=if(isbold(RC[-1]),"""",1)"
.Value = .Value
If WorksheetFunction.CountA(.Cells) < .Rows.Count Then Set SelectBold = Intersect(.SpecialCells(xlCellTypeBlanks).EntireRow, .Parent.Columns(1))
.Clear
End With
End With
End Function
Function IsBold(rCell As Range)
IsBold = rCell.Font.Bold
End Function
to be possibly exploited as follows:
Option Explicit
Sub main()
Dim subCategoriesRng As Range, cell As Range
Set subCategoriesRng = SelectBold(Worksheets("bolds").Name, "A") '<--| pass worksheet name and column to search in
If Not subCategoriesRng Is Nothing Then
For Each cell In subCategoriesRng '<--| loop through subcategories cells
'... code
Next cell
End If
End Sub