I need to remove items from a Listbox using data from Range under certain conditions. I don't want to delete data in the Worksheet the Listbox is based on.
Here is an excerpt of my code:
Me.LstWSource.RowSource = ""
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = ThisWorkbook.Sheets(G_sNameReferenceS).Range(rRange.Offset(1, 0), rRange.End(xlDown))
With Me.LstWSource
.ColumnWidths = "28pt"
.RowSource = rRange.Address
.ListIndex = -1
End With '>>>
End If
'>>>>>>>>>>>>>>>>>>>>>>>>
sRet = fG_SortingBasicS("lstYear", "DESC")
'>>>>>>>>>>>>>>>>>>>>>>>>
For i = Me.LstWSource.ListCount - 1 To 0 Step -1
'>> current string condition to delete Item <<
If Me.LstWSource.List(i) > CStr(Year(G_datJourTraitee)) Then
Me.LstWSource.RemoveItem (i)
End If
Next i
The error is triggered by the RemoveItem.
If you use .RowSource to fill your ListBox you cannot remove list items from the list.
Therefore you need to fill your list using LstWSource.AddItem. Loop through your range and add each item to your ListBox based on your criteria. Also see Adding items in a Listbox with multiple columns.
For additional information and bring my definite solution related to slowing populating : I used once the read of Range cells to populate a dynamic array. Then, I use this array to exclude or include lines in another second array.
These are lines to be considered :
J = 1
For i = LBound(G_varListYears) To UBound(G_varListYears)
If G_varListYears(i) <= CStr(Year(G_datJourTraitee)) Then
'>>>
ReDim Preserve vListTMP(J)
vListTMP(J) = G_varListYears(i)
J = J + 1
'>>
ElseIf (Me.chkNextYear = True) And ((Month(G_datJourTraitee) = 11 Or Month(G_datJourTraitee) = 12) And (G_varListYears(i) = CStr(Year(G_datJourTraitee) + 1))) Then
'>>>
ReDim Preserve vListTMP(J)
vListTMP(J) = G_varListYears(i)
J = J + 1
'>>
Else
'>>
End If
Next i
With Me.LstWSource
.ColumnWidths = "28pt"
.List = vListTMP()
.ListIndex = -1
End With '>>>
Hope it'll help too.
Related
I am trying to change the filter on a pivot table that was set up using the "Add this data to the Data Model" functionality using VBA which would read the selection of a list box containing the items to filter on. I started by recording a macro to see what would happen and was given this:
ActiveSheet.PivotTables("Pivottable1").PivotFields("[Range 1 1].[Quarter].[Quarter]").VisibleItemsList = _
Array("[Range 1 1].[Quarter].&[1Q20]", "[Range 1 1].[Quarter].&[3Q20]")
My problem is to set up the array dynamically which could contain any number of items. I need to do something like the below but appending to the array each time which this doesn't do:
For x = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(x) = True Then
myArray = Array("[Range 1 1].[Quarter].&[" & ListBox1.List(x) & "]")
End If
Next x
ActiveSheet.PivotTables("Pivottable1").PivotFields("[Range 1 1].[Quarter].[Quarter]").VisibleItemsList = myArray
I tested other ways which didn't work like using:
' This didn't work:
Set myArray = CreateObject("System.Collections.ArrayList")
myArray.Add "[Range 1 1].[Quarter].&[1Q20]"
' This method didn't work either
Dim myArray(2) As Variant
myArray2(0) = "1Q20"
myArray2(1) = "2Q20"
I need to replace Array("[Range 1 1].[Quarter].&[1Q20]", "[Range 1 1].[Quarter].&[3Q20]") with something I can set up dynamically. Any ideas on how I can do this?
Not sure what you need, but try something like this:
Dim myArray() As String,k as integer
ReDim myArray(ListBox1.ListCount-1)
k = -1
For x = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(x) = True Then
k = k + 1
myArray(k) = "[Range 1 1].[Quarter].&[" & ListBox1.List(x) & "]"
End If
Next x
ReDim Preserve myArray(k)
First bit of code resorts the order, and then refreshes the list with the new order shown in the list box.
The listbox is currently set as "Single", but I want it to be established as a "fmMultiSelectMulti". From a "Multi", I am able to gather the selected index numbers in a string with the public function call GetSelectedIndexes(userformNameHere). (i.e. "0,4,7,8,9...")
My issues is once I cut and paste the certain rows around to resort the listbox, I want to be able to show the user that they still have the same values in the listbox selected.
Public Function GetSelectedIndexes(lBox As MSForms.ListBox) As String
'returns an array of selected index numbers in a listbox
Dim tmparray() As Variant
Dim i As Integer
Dim selCount As Integer
selCount = -1
'## Iterate over each item in the ListBox control:
For i = 0 To lBox.ListCount - 1
'## Check to see if this item is selected:
If lBox.Selected(i) = True Then
'## If this item is selected, then add it to the array
selCount = selCount + 1
ReDim Preserve tmparray(selCount)
tmparray(selCount) = lBox.ListIndex
End If
Next
If selCount = -1 Then
'## If no items were selected, return an empty string
GetSelectedIndexes = "" ' or "No items selected", etc.
Else:
'## Otherwise, return the array of items as a string,
' delimited by commas
GetSelectedIndexes = Join(tmparray, ", ")
End If
End Function
here is the rest of my code which works with the single value selectable listbox:
Private Sub SpinButton1_SpinUp()
' cuts + moves UP one cell... ONLY WORKS IF FmMultiSelectSingle...
ThisWorkbook.Sheets("mon").Activate
If Not MonMissions2.ListIndex < 1 Then
selRow = MonMissions2.ListIndex + 2
Range("B" & selRow).EntireRow.Select
Selection.Cut
Selection.Offset(-1, 0).Insert Shift:=xlDown
'Reloads wing priorities list
MonMissions2.Clear
With MonMissions2
List = Range("A2:A500").Value
For i = 1 To UBound(List, 1)
If Len(Trim(List(i, 1))) > 0 Then
.AddItem Range("B" & i + 1).Value & "-" & Range("C" & i + 1).Value & "-" & Range("D" & i + 1).Value ' populate the listbox
End If
Next i
MonMissions2.ListIndex = selRow - 3
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Need to re-select previously selected ListIndex HERE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End With
End If
End Sub
am I going to have to create 100+ variables for my dynamic listbox items to determine whether they were selected to begin with? (listbox.selected(I) = true...)
Have a combobox & command button placed on excel sheet. Combobox will have some items listed, say it have 1, 2, 3, 4, 5. When the combobox is loaded for the first time, by default first value ie 1 will be selected.
Now using a VBA macro, I want to select next value from the combobox list (ie 2) and click on the command button.
I googled this but unfortunately, not getting what I am expecting.
Here is what I have so far, but it dont do what I am expecting (Explained above): Getting an error message as Object doesn't support this property or method on line If Worksheets("QC Update").ComboBox1.SelectedIndex < ComboBox1.Items.Count - 1 Then
Sub Select_Next_Items()
If IsEmpty(Range("A9").Value) = True Then
If Worksheets("QC Update").ComboBox1.SelectedIndex < ComboBox1.Items.Count - 1 Then
ComboBox1.ListIndex = 0 ' select first Item in listbox
ComboBox1.ListIndex = ComboBox1.ListCount - 1 ' selects last item
Set ComboBox1.SelectedIndex = Worksheets("QC Update").ComboBox1.SelectedIndex + 1
Set ComboBox1.ListCount = 0
End If
End If
End Sub
hope you guys don't feel offended here, as I have a more clearer and a more straight forward answer.
ComboBox1.ListIndex = ComboBox1.ListIndex +1
Here is a more complete ones. We have to take into account when it is at the end of the list therefore
If ComboBox1.ListIndex = ComboBox1.ListCount -1 Then
ComboBox1.ListIndex =1
Else
ComboBox1.ListIndex = ComboBox1.ListIndex +1
I hope my reply is helpful to most of you especially those who are new to Vba and need to use it urgently.
This is simple to understand if you have solid background on programming in C++ / java
I wonder if this is your intention.
Sub Select_Next_Item()
' 07 Apr 2017
Dim Ws As Worksheet
Dim Cbx As OLEObject
Dim Ix As Integer
Set Ws = Worksheets("QC Update")
If IsEmpty(Ws.Range("A9").Value) = True Then
Set Cbx = Ws.OLEObjects("ComboBox1")
With Cbx.Object
Ix = .ListIndex + 1
If Ix = .ListCount Then Ix = 0
If .ListCount Then .ListIndex = Ix
End With
End If
End Sub
If the cell A9 is found empty, the code will look at the "ComboBox1" (and will crash if it isn't found on the same, specified worksheet). It will change the selection in that combobox to the next value in the list. But if it was already at the last list item it will select the first, and if there are no list items in the combobox it will do nothing.
Finally this issues is resolved with below code,
Set Cbx = Worksheets("QC Update").OLEObjects("ComboBox1")
With Cbx.Object
Ix = .ListIndex + 1
If Ix = .ListCount Then Ix = 0
If .ListCount Then .ListIndex = Ix
End With
I share my simple solution
Try
ComboBoxDireccion.SelectedIndex = ComboBoxDireccion.SelectedIndex + 1
Catch ex As Exception
ComboBoxDireccion.SelectedIndex = 0
End Try
I’m using a userform with 12 listboxes (numbered 2-13). Each list box could contain 0-8 items assigned by user from main listbox1. I run the following code to output the content of each list box (12 boxes) to sheet “Tray” when a button is pressed.
Each listbox is then output into corresponding columns of each tray from columns B-M. Listbox2 fills column 1 of each tray and so on. A maximum of 4 trays can be filled. The code checks the 1st well of each tray and if it contains a value it assumes the tray is full & begins filling the next tray.
Problem: If the first tray contains a blank column(listbox) and the second tray contains values in the same listbox, the code will fill blank column of the frist tray with values that should be in the second tray. Please see pictures below and updated code below:
Listboxes 2,3 and 4 for Tray 1 (note listbox3 is empty)
Listboxes 2,3 and 4 for tray 2 (note listbox3 has data)
Code ran two times: Listbox3 from tray2 appears in tray1 (erroneously!!!)
Expected output:
Sub Worklist()
'
Dim Var, VarName As Variant
Dim i, DblDashPos, FirstPeriodPos, lngColNum, lngRowNum As Long
Dim item As ListBox
Const cstrNames As String = "Listbox2,Listbox3,Listbox4,Listbox5,Listbox6,Listbox7,Listbox8,Listbox9,Listbox10,Listbox11,Listbox12,Listbox13"
Application.ScreenUpdating = False
lngColNum = 2
For Each VarName In Split(cstrNames, ",")
If UserForm2.Controls(VarName).ListIndex <> -1 Then 'if listbox is not blank
If Sheets("Tray").Cells(4, lngColNum).Value = 0 Then
'checks if value in row 3 column "lngColNum" is empty
lngRowNum = 4
ThisWorkbook.Sheets("Tray").Range("C2").Value = UserForm2.TextBox1.Value
ElseIf Sheets("Tray").Cells(15, lngColNum).Value = 0 Then 'checks if value in row 14 column "lngColNum" is empty
lngRowNum = 15
ThisWorkbook.Sheets("Tray").Range("C13").Value = UserForm2.TextBox1.Value
ElseIf Sheets("Tray").Cells(26, lngColNum).Value = 0 Then 'checks if value in row 14 column "lngColNum" is empty
lngRowNum = 26
ThisWorkbook.Sheets("Tray").Range("C24").Value = UserForm2.TextBox1.Value
Else 'otherwise assumes tray starts in row 5, column "lngColNum"
lngRowNum = 37
ThisWorkbook.Sheets("Tray").Range("C35").Value = UserForm2.TextBox1.Value
End If
For i = 0 To UserForm2.Controls(VarName).ListCount - 1
Var = UserForm2.Controls(VarName).List(i)
DblDashPos = InStr(1, Var, "--")
FirstPeriodPos = InStr(1, Var, ".")
Sheets("Tray").Select
ActiveSheet.Cells(lngRowNum, lngColNum) = Left(Var, DblDashPos - 1) & Right(Var, Len(Var) - FirstPeriodPos + 1)
lngRowNum = lngRowNum + 1
Next i
End If
lngColNum = lngColNum + 1
Next
Application.ScreenUpdating = True
End Sub
Thank you very much!
The problem is that you're only testing the column that corresponds to the ListBox to see if the cell is empty. If you want to test that all of the columns in a "tray" are empty, you need to test once for the entire sheet. Something like this (untested because I'm too lazy to rebuild your form):
Private Function FindFirstUnusedRow(sheet As Worksheet) As Long
Dim testColumn As Long, testRow As Long
Dim used As Boolean
For testRow = 4 To 37 Step 11
used = False
For testColumn = 2 To 13
If IsEmpty(sheet.Cells(testRow, testColumn)) = False Then
used = True
Exit For
End If
Next testColumn
If used = False Then
FindFirstUnusedRow = testRow
Exit For
End If
Next testRow
End Function
Then in your code, call it before your loop:
Sub Worklist()
Dim var As Variant
Dim i As Long, dashPos As Long, periodPos As Long, colNum As Long
Dim rowNum As Long, Dim sheet As Worksheet
Application.ScreenUpdating = False
Set sheet = ThisWorkbook.Sheets("Tray")
rowNum = FindFirstUnusedRow(sheet)
If rowNum = 0 Then
Debug.Print "All trays full."
Exit Sub
End If
Dim current As ListBox
For colNum = 2 To 13
Set current = UserForm2.Controls("Listbox" & colNum)
If current.ListIndex <> -1 Then 'if listbox is not blank
sheet.Cells(rowNum - 2, colNum).Value = UserForm2.TextBox1.Value
For i = 0 To current.ListCount - 1
var = current.List(i)
dashPos = InStr(1, var, "--")
periodPos = InStr(1, var, ".")
sheet.Cells(rowNum + i, colNum) = Left$(var, dashPos - 1) & _
Right$(var, Len(var) - periodPos + 1)
Next i
End If
Next colNum
Application.ScreenUpdating = True
End Sub
A couple other notes: You can ditch the Sheets("Tray").Select line entirely - you never use the selection object. Same thing with the mixed references to ActiveSheet and ThisWorkbook.Sheets("Tray"). Grab a reference and use it.
Also, these lines don't do what you think they do:
Dim Var, VarName As Variant
Dim i, DblDashPos, FirstPeriodPos, lngColNum, lngRowNum As Long
Of all the variables you declare, everything is a Variant except lngRowNum. If you want to combine declarations on one line like that, you still need to specify a type for each variable, or they'll default to Variant. See the example code above.
I have this code that suppose to copy column titles from a file and add those titles as checkboxess to a checklist. But when I execute the code it will copy the column titles but it does not create check boxes. Any idea why it doesn't?
If sj = True Or ji = True Then
For j = 1 To 199
If Trim(wks1.Cells(4, j).Value) = "" Then
titlesj = j - 1
Exit For
End If
jTitles(j - 1) = wks1.Cells(4, j).Value
Next
j = 1
' Add column titles from files into the listbox as checkboxes
For j = 0 To titlesj
Sheet1.ListBox1.AddItem jTitles(j)
Sheet1.ListBox3.AddItem jTitles(j)
Next
wb1.Close
End If
Try this... set the ListStyle and MultiSelect properties for both "Listbox1" and "ListBox3" to "1". Place the following before both loops.
Sheet1.ListBox1.ListStyle = 1
Sheet1.ListBox1.MultiSelect = 1
Sheet1.ListBox3.ListStyle = 1
Sheet1.ListBox3.MultiSelect = 1
Source: http://www.excelforum.com/excel-programming-vba-macros/685957-listbox-with-checkboxes.html