I have a listbox named ListBox1 on Sheet1 of an Excel workbook.
Every time the user selects one of the items in the list, I need to copy its name to a variable named strLB.
So, if I have Value1, Value2, Value3, Value4 and the user selects Value1 and Value3, I need my strLB to come out as Value1,Value3.
I tried doing that post hoc with:
For i = 1 To ActiveSheet.ListBoxes("ListBox1").ListCount
If ActiveSheet.ListBoxes("ListBox1").Selected(i) Then strLB = strLB & etc.etc.
Next i
But this is very slow (I have 15k values in my listbox). This is why I need to record the selection in real time and not in a cycle, after the user is done inputting.
I'm going to also need a way to check if the user removed any of the previous selection.
Unfortunately for MSForms list box looping through the list items and checking their Selected property is the only way. However, here is an alternative. I am storing/removing the selected item in a variable, you can do this in some remote cell and keep track of it :)
Dim StrSelection As String
Private Sub ListBox1_Change()
If ListBox1.Selected(ListBox1.ListIndex) Then
If StrSelection = "" Then
StrSelection = ListBox1.List(ListBox1.ListIndex)
Else
StrSelection = StrSelection & "," & ListBox1.List(ListBox1.ListIndex)
End If
Else
StrSelection = Replace(StrSelection, "," & ListBox1.List(ListBox1.ListIndex), "")
End If
End Sub
The accepted answer doesn't cut it because if a user de-selects a row the list is not updated accordingly.
Here is what I suggest instead:
Private Sub CommandButton2_Click()
Dim lItem As Long
For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
MsgBox(ListBox1.List(lItem))
End If
Next
End Sub
Courtesy of http://www.ozgrid.com/VBA/multi-select-listbox.htm
To get the value of the selected item of a listbox then use the following.
For Single Column ListBox:
ListBox1.List(ListBox1.ListIndex)
For Multi Column ListBox:
ListBox1.Column(column_number, ListBox1.ListIndex)
This avoids looping and is extremely more efficient.
Take selected value:
worksheet name = ordls
form control list box name = DEPDB1
selectvalue = ordls.Shapes("DEPDB1").ControlFormat.List(ordls.Shapes("DEPDB1").ControlFormat.Value)
Related
I'm writing some VBA code for a user form. The values are selected in a listbox on the left (LB_Participants). Then "select" is pressed and the values are copied to a listbox on the right (LB_Output). I then want VBA to go through all these items seperatly in the LB_Output and look up other associated data from another worksheet. Problem I'm having is that somethimes the values are not selected. I check it with a messagebox and from time to time its blank. Then no associated data can be retrieved ofcourse.
Before starting to fill in the userform, if I just click once on LB_Output (even without selecting any value) I don't have this problem. Many people will be using the userform so I don't want to explain tot them that they have to click first on the listbox before continuing... Is there something I'm not doing right?
Blank Msgbox
Dim ListCount As Integer
Dim z As Integer
ListCount = UserForm2.LB_Output.ListCount
For z = 0 To ListCount - 1
UserForm2.LB_Output.Selected(z) = True
TextString = UserForm2.LB_Output.Value
MsgBox (TextString)
'Split Participants into seperate names and copy them to data sheet
WArray() = Split(TextString, ";")
For Counter = LBound(WArray) To UBound(WArray)
Dim LRNames As Integer
If IsEmpty(Sheets("Data").Range("A1")) = True Then
LRNames = 0
Else
LRNames = Sheets("Data").Range("A" & Application.Rows.Count).End(xlUp).Row
End If
Strg = WArray(Counter)
Sheets("Data").Cells(LRNames + 1, 1) = Trim(Strg)
Next Counter
Next z
Not sure I understand, but think you want to loop through all the items in LB_Output and process them regardless if selected or not - all the selection was done in the other listbox and those items moved to LB_Output.
This does not explicitly select each item, simply gets data from it.
For z = 0 to UserForm2.LB_Output.Listcount -1
' If you want to select the item to show 'progress' through the list,
' uncomment ...
' LB_Output.listindex = z
' The next line will still work as is
TextString = UserForm2.LB_Output.List(z)
'// Do processing with this item
Next
I'm new to VBA and I'm trying to set up a customizable sheet that allows the user to filter certain columns based on the checkboxes that I have set up. So far, I understand how checkboxes work and how I can integrate them into the code, but I think I have an issue with the autofilter function. Specifically, I think that I'm putting the wrong value for Criteria1.
I've been looking around for similar coding problems, but none of them seem to work with what I'm trying to do.
TL;DR I think my issue lies with how I format the array to put in Criteria1 of the AutoFilter()
Sub Auto_filter()
'variables are for checkboxes'
Dim VC1500 As Shape
Dim VC7500 As Shape
Dim VC144024 As Shape
'initiates to check for the checkboxes'
Set VC1500 = Sheets("Sheet7").Shapes("Check Box 4")
Set VC7500 = Sheets("Sheet7").Shapes("Check Box 5")
Set VC144024 = Sheets("Sheet7").Shapes("Check Box 6")
'if statement that will add a string to strCriteria if checkbox is true'
If VC1500.OLEFormat.Object.Value = 1 Then
strCriteria = strCriteria & ", VC1500"
End If
If VC7500.OLEFormat.Object.Value = 1 Then
strCriteria = strCriteria & ", VC7500"
End If
If VC144024.OLEFormat.Object.Value = 1 Then
strCriteria = strCriteria & ", 144024"
End If
'with statement that finds for column vendor then filter it based on
strCriteria, I think this is where my issue is'
With Worksheets("Open Purchase Orders")
With .Range("A1", .Cells(1, Columns.Count).End(xlToLeft))
Set vendorfind = .Rows(1).Find("Vendor")
If Not vendorfind Is Nothing Then
.AutoFilter Field:=vendorfind.Column,
Criteria1:=Split(strCriteria, ", "), Operator:=xlFilterValues
End If
End With
.AutoFilterMode = False
End With
End Sub
I expect to have the sheet filtered based on the checkboxes.
I get a runtime error 9 error:subscript out of range
Have you tried using Slices?
Its easy and should do simple filters without Macros.
Select your data > Insert Table.
Once the table is done, from the Design tab you can select "Insert Slicer".
Try if this solves your problem.
Some parts of that code look to me like scratching your left ear with your right hand going over your head. But I'm not entirely clear on how it actually looks (a sample would be helpful) - does each vendor have some separate indication column? If so, what are you filtering there? A vendor tag, by the looks of it?
This for example is a solution for a single vendor column (D) which may contain the 3 names. It basically applies an autofilter of a list of values. (I'm using activex checkboxes below as their properties can be accessed directly.)
Private Sub VC1500_Click()
Update_Filter
End Sub
Private Sub VC7500_Click()
Update_Filter
End Sub
Private Sub VC144024_Click()
Update_Filter
End Sub
Private Sub Update_Filter()
Dim varr_filter(3) As String
Dim indshow As Boolean
indshow = True
If VC1500 Then
varr_filter(0) = VC1500.Caption
indshow = False
End If
If VC7500 Then
varr_filter(1) = VC7500.Caption
indshow = False
End If
If VC144024 Then
varr_filter(2) = VC144024.Caption
indshow = False
End If
If indshow Then
Range("$A:$D").AutoFilter
Else
Range("$A:$D").AutoFilter field:=4, Criteria1:=varr_filter, Operator:=xlFilterValues
End If
End Sub
Note: Pick the correct column for filtering as the "field" value, and if you wish to separate the checkboxes from the form for some reason, then add """sheets("sheetname").{each checkbox}""".
Alternatively, if each of the vcs possesses a separate column, and seeking rows which literally say "vendor", I'd merge them in the sheet like so:
E2=if(cond1)*checkbox1 + if(cond2)*checkbox2 + if(cond3)*checkbox3 ; E > 0.
Cond1 could be b2="Vendor", for example.
To make the sheet display all cols when no ticks are selected,
I've added another value: 1 - max(checkboxes).
E6=1-MAX($H$4:$H$6) + IF(AND(B2="Vendor"),1,0)*$H$4 +
IF(AND(C2="Vendor"),1,0)*$H$5 + IF(AND(D2="Vendor"),1,0)*$H$6
That's one example where a hidden sheet value helps, since you can actually define such a column without vb. And then, the code itself is simplified a bit.
Private Sub VC1500_Click()
If VC1500.Value Then
Range("$H$4").Value = 1
Else
Range("$H$4").Value = 0
End If
Update_Filter
End Sub
Private Sub VC7500_Click()
If VC7500.Value Then
Range("$H$5").Value = 1
Else
Range("$H$5").Value = 0
End If
Update_Filter
End Sub
Private Sub VC144024_Click()
If VC144024.Value Then
Range("$H$6").Value = 1
Else
Range("$H$6").Value = 0
End If
Update_Filter
End Sub
Private Sub Update_Filter()
Range("$A:$E").AutoFilter field:=5, Criteria1:=">0", Operator:=xlFilterValues
End Sub
It's also easier to transition to a form control, by checking the range value during click instead of the checkbox, and hiding column H. Not entirely bulletproof yet sufficient for the average user. Either that or read the shape as you wrote.
Edit: Added tested code above for both cases (single col, multicol), including displaying all rows when no tickboxes are checked rather than none. Here are the demo shots.
Single col code
Single col sample sheet
Single col filtered
Multicol code
Multicol sample
Multicol filtered
I've got three combo boxes in a workbook that I want to daisy chain together. Item lists for each combo box refresh when you hit the down arrow on the keyboard after clicking the drop down button on the combo box. The second combo box list is dependent on the selection made in the first combo box. I've built these using scripting dictionaries.
strCustComboBox is the value in the previous combo box that the current combo box should be dependent on.
rngProject is looking at a range with lots of quote IDs in it. I offset from this column to the column where the values for the previous combo box are held and if this value is equal to strCustComboBox then add rngCompany value to the scripting dictionary
I'm running into a problem in the loop where I am trying to de-duplicate the rngCompany values written into the scripting dictionary that is used to build the list to be shown in the combo box. My code is below.
Sub UpdateComboBox1FromDashData()
Dim strCustComboBox As MSForms.ComboBox
Dim strComboBox As MSForms.ComboBox
Dim rngCompany As Range
Dim rngProject As Range
Dim d As Object, c As Variant, i As Long
Worksheets("QuoteEditor").Unprotect "xxxx"
Application.ScreenUpdating = False
Set strCustComboBox = ThisWorkbook.Worksheets("QuoteEditor").ComboBox4
Set strComboBox = ThisWorkbook.Worksheets("QuoteEditor").ComboBox1
If strCustComboBox = "" Then
MsgBox "Please select a project first", vbOKCancel
Else
End If
ThisWorkbook.Worksheets("DashboardData").Select
Call FindLastRow("A", "10")
Set d = CreateObject("Scripting.Dictionary")
c = Range("A10:A" & strLastRow)
Set rngProject = ThisWorkbook.Worksheets("DashboardData").Range("A10:A" & strLastRow)
i = 1
For Each rngCompany In rngProject
If UCase(rngCompany.Offset(, 7).Value) = UCase(strCustComboBox) Then
If d.exists(rngCompany) = True Then
Else
d.Add rngCompany, i
i = i + 1
End If
Else
End If
Next rngCompany
For Each Item In d
strComboBox.AddItem (Item)
Next Item
I think where I am using d.exists(rngCompany) is wrong but I'm not sure. When the subroutine finishes I still get duplicate data return to the combo box list.
I've also tried the code below as per the suggested duplicate thread:
With d
For Each rngCompany In rngProject
If UCase(rngCompany.Offset(, 7).Value) = UCase(strCustComboBox) Then
If Not .exists(rngCompany) Then
d.Add rngCompany, Nothing
Else
End If
End If
Next rngCompany
End With
Can anyone see where either of these are going wrong?
You hid the answer to this in your own question (emphasis mine):
where I am trying to de-duplicate the rngCompany values
There is no way for d.Exists(rngCompany) to return true the way that you have this written, because you are keying the Dictionary on the range, not its contents. Since the items you are testing are part of the iteration For Each rngCompany In rngProject, you are guaranteed to have only distinct ranges.
The solution is trivial - you need to explicitly call the default member of rngCompany:
If Not d.Exists(rngCompany.Value) Then
d.Add rngCompany.Value, i
i = i + 1
End If
I'd like search from a combobox on a userform, returning 2 items from 2 different rows. So far I am using a predetermined location set to return the alternate rows.
My question is about this section:
Private Sub ComboBox1_Change()
If ComboBox1.Text = Sheet1.Cells(3, 1) Then
oHousing.Text = Sheet1.Cells(3, 2)
oMeal.Text = Sheet1.Cells(3, 3)
End If
End Sub
Here is what the pseudocode would do:
User selects item in combobox
combobox will search A1:A99 for item
then once item is found it will output B# and C# (# is based on location of A#)
B# is outputted to oHousing (textbox)
C# is outputted to oMeal (textbox)
On my sheet I have:
A2:A28 with random text (I used ABC's)
B2:B28 are random 3 digit numbers (numeric, eg: 001-999)
C2:C28 is Random 3 numbers (numeric, eg: 001-999)
Here's the rest of my code:
'Finds the difference in 2 known dates (returns whole number in textbox)
Private Sub CommandButton1_Click()
Dim firstDate As Date, secondDate As Date, n As Integer
firstDate = DateValue(sDate.Text)
secondDate = DateValue(EDate.Text)
n = DateDiff("d", firstDate, secondDate) - 0.5
dTotal.Text = n
End Sub
Private Sub CommandButton2_Click() 'Exit the userform (PerDiem)
Unload PerDiem
End Sub
Thanks to all in advance!
You can use the Find function.
If a value is found, you can return the Row Number with Found.Row and Column Index with Count.Column
Private Sub ComboBox1_Change()
Dim Found As Range
Set Found = Sheet1.Range("A1:A99").Find(ComboBox1.Text, , xlValues, xlWhole)
If Found Is Nothing Then
'What do you want to do if your value in CommboBox is not found in the range?
Else
oHousing.Text = Sheet1.Cells(Found.Row, 2)
oMeal.Text = Sheet1.Cells(Found.Row, 3)
End If
End Sub
If you are sure that your ComboBox value will always exist in your range (maybe you systematically programmed your ComboBox values this way) you can skip the check and simply use:
Dim Found As Range
Set Found = Sheet1.Range("A1:A99").Find(ComboBox1.Text, , xlValues, xlWhole)
oHousing.Text = Sheet1.Cells(Found.Row, 2)
oMeal.Text = Sheet1.Cells(Found.Row, 3)
You can find properties of the Find method here. If you are looking for text, you may need to distinguish between case sensitivity (for your needs, does THIS = this?). The properties that are currently applied means the function is looking for values (xlValues), specifically, looking at the whole value of the cell (xlWhole). I.E. (this value will not match with this)
I apologise now as I am an absolute beginner (also my pictures and code haven't been generalised).
I have a drop down list box in Excel, populated by a range I selected whilst inside excel (ie right click the ActiveX Control after it has been placed and alter the properties). I would like it so that if certain items in the list are selected, other items are removed from the list so that they cannot be selected. Eg. there is a list A, B, and C, but upon a user selecting A, B disappears from the list.
My code is as follows. This first part codes for the drop down list
Sub Rectangle1_Click()
Dim SelShp As Shape, ListShp As Shape, SelList As Variant, i As Integer
Set SelShp = Sheet8.Shapes(Application.Caller)
Set ListBx = Sheet8.ListBox1
If SelShp.TextFrame2.TextRange.Characters.Text = "Select Buffers" Then
ListBx.Visible = True
SelShp.TextFrame2.TextRange.Characters.Text = "Set Buffers"
Else
ListBx.Visible = False
SelShp.TextFrame2.TextRange.Characters.Text = "Select Buffers"
For i = 0 To Sheet8.ListBox1.ListCount - 1
If Sheet8.ListBox1.Selected(i) = True Then
SelList = SelList & "; " & Sheet8.ListBox1.List(i)
End If
Next i
If SelList <> "" Then
Range("ListBox1Output") = Right(SelList, Len(SelList) - 1)
Else
Range("ListBox1Output") = ""
End If
End If
End Sub
This second code is what is supposed to remove items from the list
Private Sub ListBox1_Change()
If Sheet8.ListBox1.Selected(0) Then
Sheet8.ListBox1.RemoveItem 1
End If
End Sub
The problem is, when I try it out I get a run-time error '-2147467259 (80004005)': Unspecified error., and if I try and debug it highlights the 'Sheet8.ListBox1.RemoveItem 1', but I just don't know enough to know what I'm doing wrong. Any help would be much appreciated, and I'm sorry if I'm missing something really simple.
Edit: I've been working on this since I posted, and have found some solutions, but run into other roadblocks.
My first problem was that the .RemoveItem method wasn't doing anything. Turns out if a ListBox is populated by using the .ListFillRange method, .RemoveItem won't work – a ListBox has to be populated by using .AddItem if I later want to .RemoveItem.
After I worked that out, I decided to try and do what I want with simpler data:
I have 2 Listboxes and I populate one of them with data. Upon selecting an item in ListBox1, that item is copied into ListBox2, and it is removed from ListBox1. Also, if certain items in ListBox1 are selected, other items are removed from the listbox so that they cannot be selected. Eg. there is a list A, B, and C, but upon a user selecting A, B disappears from the list.
I have got my code to the point where it works in certain situations. Unfortunately, the sequence of the items is important, and for some reason, for certain sequences of items, the code does not work as expected – eg my generalised items happen to be: Germany, India, France, USA, England. Upon selecting 'Germany', this item appears in ListBox2, it is removed from ListBox1, and also, 'France' is removed from ListBox1. This works fine, until the items are put in alphabetical order, at which point upon selecting 'Germany', this item appears in ListBox2, it is removed from ListBox1, 'France' is removed from ListBox1, AND India and USA are moved into ListBox2...?? It's as if once 'France' has been deleted, whatever was below it is selected and runs through the first 2 loops of the ListBox1_Change() sub for some reason. Interrupting it with a messagebox works for some reason, but I can't work out how to interrupt it without using the messagebox...
My code is as follows, with some comments on what I tried included in it.
Populate ListBox1 with items in random positions
Sub Populate_ListBox1()
'Clear LB1 before populating it
Sheet1.ListBox1.Clear
Sheet1.ListBox2.Clear
Sheet1.ListBox1.AddItem "Germany"
Sheet1.ListBox1.AddItem "India"
Sheet1.ListBox1.AddItem "France"
Sheet1.ListBox1.AddItem "USA"
Sheet1.ListBox1.AddItem "England"
End Sub
Try to move selected ListBox1 items while changing what items are in ListBox1
Private Sub ListBox1_Change()
'Variable Declaration
Dim iCnt As Integer
Dim jCnt As Integer
Dim kCnt As Integer
'Move Selected Item from Listbox1 to Listbox2
For iCnt = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(iCnt) = True Then
Me.ListBox2.AddItem Me.ListBox1.List(iCnt)
End If
Next
'Clear Selected Item from Listbox1
For iCnt = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(iCnt) = True Then
Me.ListBox1.RemoveItem iCnt
'Me.ListBox1.Selected(iCnt) = False 'Nope
'Exit For
End If
Next
'If Germany is in Listbox2, then remove France from LB1
For kCnt = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Column(0, kCnt) = "Germany" Then
For jCnt = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Column(0, jCnt) = "France" Then
Me.ListBox1.RemoveItem jCnt
'Me.ListBox1.Locked = True 'Nope
'Me.ListBox1.Enabled = False 'Nope
'Me.ListBox1.ListIndex = -1 'This crashes excel...
'MsgBox "blah" 'For some reason this works >.<
Exit Sub
End If
Next jCnt
End If
Next
End Sub
I'd really appreciate help with this, and would even take advice on using a different program that would work with excel (trying to alter items in a listbox based upon their index, which changes, rather than on their values is a nightmare)