Object required Run-time error 424 - excel

I have a list of checkboxes and after some of them are checked I would like to know which ones are checked so I can work with those checked boxes. Not sure why these few lines don't work. After I execute it there is a pop up error message saying "Object required" Run-time error '424': and highlights line => ReDim SelectedItemArray(ListBox1.ListCount) As String. Yes I have four ListBoxes; ListBox1, ListBox2, ListBox3, ListBox4. Any help is appreciated. Thank you
Sub CheckedBoxes()
Dim SelectedItemArray() As String
ReDim SelectedItemArray(ListBox1.ListCount) As String
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
SelectedItemArray(i) = ListBox1.List(i)
End If
Next
End Sub

You need to fully qualifying the listbox. For example Sheet1.ListBox1.ListCount

This is a function I use for ListBoxes on a UserForm. I modified it (further below) for use on Worksheet listboxes.
For form controls ListBox on a UserForm, call it like:
myArray = GetSelectedItems(ListBox1)
Here's the function which will accept any listbox from a UserForm as a named argument:
Public Function GetSelectedItems(lBox As MSForms.ListBox) As Variant
'returns an array of selected items in a ListBox
Dim tmpArray() As Variant
Dim i As Integer
Dim selCount As Integer
selCount = -1
For i = 0 To lBox.ListCount - 1
If lBox.Selected(i) = True Then
selCount = selCount + 1
ReDim Preserve tmpArray(selCount)
tmpArray(selCount) = lBox.List(i)
End If
Next
If selCount = -1 Then
GetSelectedItems = Array()
Else:
GetSelectedItems = tmpArray
End If
End Function
If you are referring to a ListBox on a worksheet, try this instead:
Call it like this:
myArray = GetSelectedItems(Sheet1.Shapes("List Box 1").OLEFormat.Object)
Here's the function modified for Worksheet form control ListBox:
Public Function GetSelectedItems(lBox As Object) As Variant
'returns an array of selected items in a ListBox
Dim tmpArray() As Variant
Dim i As Integer
Dim selCount As Integer
selCount = -1
For i = 1 To lBox.ListCount - 1
If lBox.Selected(i) = True Then
selCount = selCount + 1
ReDim Preserve tmpArray(selCount)
tmpArray(selCount) = lBox.List(i)
End If
Next
If selCount = -1 Then
GetSelectedItems = Array()
Else:
GetSelectedItems = tmpArray
End If
End Function

Related

Need ComboBoxes to automatically update

As you see in the above image, I have 2 ComboBoxes: "Select Dimension" and "List of possible values".
There are different dimensions the user can select and for each dimension there's a list of possible values. My code is partially working well. When I select a dimension for the 1st time the list of possible values appears properly.
Problem: When I select a different dimension, the list of possible values from the previous dimension still appears, instead of the values for the new selected dimension.
Question: Is there a way to solve this issue? So that when I switch between dimensions the lists of possible values also update.
#1: Function that gets the values from the Worksheet and adds them to the "List of possible values" combobox.
Public Function DimValuesSearch(strSearch As String)
Call loadWbVariables
Dim selectedDimension As String, possibleValue As String
Dim countValues As Long
Dim DimCell As Range
selectedDimension = frmSeg.seg_cbb_selDim.Value
Set DimCell = dtValWs.Rows(1).Find(What:=strSearch)
If selectedDimension = strSearch Then
countValues = 0
While dtValWs.Cells(4 + countValues, DimCell.Column) <> ""
possibleValue = dtValWs.Cells(4 + countValues, DimCell.Column)
frmSeg.seg_cbb_posVal.AddItem possibleValue
countValues = countValues + 1
Wend
End If
End Function
#2: I call the function using the different dimensions name. seg_cbb_selDim is the Dimension ComboBox.
Public Sub seg_cbb_selDim_Change()
' Functions that calls text dimensions
' Insert remaining dimensions
Call DimValuesSearch("Specialty Grouping")
Call DimValuesSearch("Primary Specialty")
End Sub
It was more simple than I though, I had to do a small change in the function above. Here's the new function:
Public Function DimValuesSearch(strSearch As String)
Call loadWbVariables
Dim selectedDimension As String, possibleValue As String
Dim countValues As Long
Dim DimCell As Range
selectedDimension = frmSeg.seg_cbb_selDim.Value
Set DimCell = dtValWs.Rows(1).Find(What:=strSearch)
If selectedDimension = strSearch Then
countValues = 0
frmSeg.seg_cbb_posVal.Clear 'Added this line here
While dtValWs.Cells(4 + countValues, DimCell.Column) <> ""
possibleValue = dtValWs.Cells(4 + countValues, DimCell.Column)
frmSeg.seg_cbb_posVal.AddItem possibleValue
countValues = countValues + 1
Wend
End If
End Function
You need to use the Change event of your Dimension box to remove all items in the other combo and reload it with the desired items.
It would look something like this:
Private Sub ComboBoxDimensions_Change()
Me.ComboBox2.Clear
LoadValuesIntoComboBox2
Me.ComboBox3.Clear
LoadValuesIntoComboBox3
End Sub
Public Sub LoadValuesIntoComboBox2()
'your code to reload the desired data ino ComboBox2
End Sub
Public Sub LoadValuesIntoComboBox3()
'your code to reload the desired data ino ComboBox3
End Sub

VBA Excel ListView Checkboxes do not show in Userform

I have a UserForm with a MultipageControl (name Controller_MultiPage).
At runtime my code adds pages to the Multipage and creates a newListView on each page.
Every ListView has:
With newListView
.MultiSelect = False
.Width = Controller_MultiPage.Width - 10
.Height = Controller_MultiPage.Height - 20
.View = lvwReport
.HideColumnHeaders = False
.ColumnHeaders.Add Text:="Signal Name", Width:=.Width / 10 * 4
.ColumnHeaders.Add Text:="Type", Width:=.Width / 10
.ColumnHeaders.Add Text:="I/O", Width:=.Width / 10
.ColumnHeaders.Add Text:="Description", Width:=.Width / 10 * 4
.CheckBoxes = True
.FullRowSelect = True
End With
then I populate the newListView with data from an XML file:
For Each node In list
With node.Attributes
Set listItem = newListView.ListItems.Add(Text:=.getNamedItem("Name").Text)
listItem.ListSubItems.Add = .getNamedItem("Type").Text
listItem.ListSubItems.Add = IIf(.getNamedItem("Input").Text = "1", "IN", "OUT")
listItem.ListSubItems.Add = .getNamedItem("Description").Text
listItem.Checked = False
End With
Next
but the checkboxes do not show. I can see the space for them in front of the first column and by clicking that space the checkbox of that particular row then appears. What I also noticed is that if I change the property
listItem.Checked = True
the behavior described above does not change, and when I click the free space in front of the first column (checkboxes space) the chsckbox that then shows up is still unchecked.
Any idea?
The problem seems to be in the behavior of the MultiPage control.
What I noticed was that if I forced the checkboxes' status (checked or unchecked) from the code, using the MultiPage_Change event, then the checkboxes show up.
So what I did was to create a class that holds the status of all checkboxes of all listviews on a single page, instantiate the Class for each ListView and store everything into a Dictionary, using the newListView.Name as Key
Then when the user changes page, the MultiPage_Change event that fires resets all the values of the checkboxes according to the Dictionary stored values.
In the Listview_N_ItemChecked event some other code updates the status of the item stored in the Dictionary.
Kind of cumbersome but it works.
the class (updated):
' Class Name = ComponentsSignalsRecord
Option Explicit
Dim Name As String
' NOTE: Signals(0) will always be empty and status(0) will always be False
Dim Signals() As String
Dim Status() As Boolean
Dim Component As String
Property Let SetComponentName(argName As String)
Component = argName
End Property
Property Get GetComponentName() As String
GetComponentName = Component
End Property
Property Get getSignalName(argIndex) As String
If argIndex >= LBound(Signals) And argIndex <= UBound(Signals) Then
getSignalName = Signals(argIndex)
Else
getSignalName = vbNullString
End If
End Property
Property Get dumpAll() As String()
dumpAll = Signals
End Property
Property Get Count() As Long
Count = UBound(Signals)
End Property
Property Get getStatus(argName As String) As Integer
' returns: -1 = Not Found; 1 = True; 0 = False
getStatus = -1
Dim i As Integer
For i = 0 To UBound(Signals)
If argName = Signals(i) Then getStatus = IIf(Status(i) = True, 1, 0): Exit For
Next
End Property
Property Let setName(argName As String)
Name = argName
End Property
Property Get getName() As String
getName = Name
End Property
Public Sub UncheckAll()
Dim i As Integer
For i = 0 To UBound(Status)
Status(i) = False
Next
End Sub
Public Sub CheckAll()
Dim i As Integer
For i = 0 To UBound(Status)
Status(i) = True
Next
End Sub
Public Sub deleteSignal(argName As String)
Dim spoolSignals() As String
Dim spoolStatus() As Boolean
Dim i As Integer
spoolSignals = Signals
spoolStatus = Status
ReDim Signals(0)
ReDim Status(0)
For i = 1 To UBound(spoolSignals)
If argName <> spoolSignals(i) Then
ReDim Preserve Signals(UBound(Signals) + 1): Signals(UBound(Signals)) = spoolSignals(i)
ReDim Preserve Status(UBound(Status) + 1): Status(UBound(Status)) = spoolStatus(i)
End If
Next
End Sub
Public Sub addSignal(argName As String, argValue As Boolean)
Dim i As Integer
For i = 0 To UBound(Signals)
If argName = Signals(i) Then GoTo bye
Next
ReDim Preserve Signals(UBound(Signals) + 1)
ReDim Preserve Status(UBound(Status) + 1)
Signals(UBound(Signals)) = argName
Status(UBound(Status)) = argValue
bye:
End Sub
Public Sub setStatus(argName As String, argValue As Boolean)
Dim i As Integer
For i = 0 To UBound(Signals)
If argName = Signals(i) Then Status(i) = argValue: Exit For
Next
End Sub
Private Sub Class_Initialize()
ReDim Signals(0)
ReDim Status(0)
End Sub
The Form relevant code. Module level:
Dim myDict As New Dictionary ' the Dictionary
Dim ComponentsSignalsList As ComponentsSignalsRecord ' the Class
for each ListView created, may be one or more for every single MultiPage page :
Set ComponentsSignalsList = New ComponentsSignalsRecord
ComponentsSignalsList.setName = newListView.name
while populating the listview(s) in a loop for each single item added:
ComponentsSignalsList.addSignal List_Item.Text, List_Item.Checked
end of each loop, add the Class instance to the Dictionary:
myDict.Add ComponentsSignalsList.getName, ComponentsSignalsList
Now when changing Page in the MultiPage widget:
Private Sub Controller_MultiPage_Change()
If isLoading Then Exit Sub 'avoid errors and undue behavior while initializing the MultiPage widget
Dim locControl As Control
Dim controlType As String: controlType = "ListView"
With Controller_MultiPage
For Each locControl In .Pages(.value).Controls
If InStr(1, TypeName(locControl), controlType) > 0 Then
Call Check_CheckBoxes(locControl)
End If
Next
End With
End Sub
Private Sub Check_CheckBoxes(argListView As listView)
If argListView.CheckBoxes = False Then Exit Sub 'some ListViews don't have checkboxes
Dim myItem As ListItem
For Each myItem In argListView.ListItems
With myItem
.Checked = myDict.Item(argListView.name).getStatus(.Text)
End With
Next
End Sub
when ticking/unticking a checkbox (note the the ItemChecked event handler is defined in another Class Public WithEvents, where the handler calls this method passing both the ListView ID and the Item object) :
Public Sub ListViewsEvents_ItemCheck(argListView As listView, argItem As MSComctlLib.ListItem)
With argItem
myDict.Item((argListView .name).setStatus argName:=.Text, argValue:=.Checked
End With
End Sub
I just found the answer to the same problem that I also had and I feel so stupid. I had the first column of the Listview set to Width = 0... and thus the checkboxes would no longer show.
I gave it a width and everithing is back to normal...

Exporting multiple datagridviews to different tabs of excelsheet

I'm a newbie to visual studio.
I want to export different datagridviews from multiple forms to an excel workbook as different sheets on the same workbook based on whether it is checked in checkedlist box.
Basically I am doing a daily checklist for our school on location basis where the user can export checklist floor wise on the corresponding form of each floor, but also can export a multiple sheet workbook containing diff floors as per its checked in checklistbox, any help please? I am stuck at checkedlistbox. currently i am doing as below: but gives me an exception at the second sheet.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim excel As Microsoft.Office.Interop.Excel._Application = New Microsoft.Office.Interop.Excel.Application()
Dim workbook As Microsoft.Office.Interop.Excel._Workbook = excel.Workbooks.Add(Type.Missing)
Dim worksheet As Microsoft.Office.Interop.Excel._Worksheet = Nothing
Me.Cursor = Cursors.WaitCursor
Dim sheetnumber As Integer = 1
If CheckedListBox1.GetItemChecked(0) = True Then
worksheet = workbook.Sheets(sheetnumber)
sheetnumber = sheetnumber + 1
worksheet.Name = "Anim_Check List_"
Dim cellRowIndex As Integer = 1
Dim cellColumnIndex As Integer = 1
For i As Integer = 0 To Form7.DataGridView1.Rows.Count - 1
For j As Integer = 0 To Form7.DataGridView1.Columns.Count - 1
If cellRowIndex = 1 Then
worksheet.Cells(cellRowIndex, cellColumnIndex) = Form7.DataGridView1.Columns(j).HeaderText
Else
worksheet.Cells(cellRowIndex, cellColumnIndex) = Form7.DataGridView1.Rows(i).Cells(j).Value.ToString()
End If
cellColumnIndex += 1
Next
cellColumnIndex = 1
cellRowIndex += 1
Next
End If
If CheckedListBox1.GetItemChecked(1) = True Then
workbook.Worksheets.Add(sheetnumber)
excel.Worksheets(sheetnumber).activate
sheetnumber = sheetnumber + 1
worksheet.Name = "Edits 1-5_"
Dim cellRowIndex As Integer = 1
Dim cellColumnIndex As Integer = 1
For i As Integer = 0 To Form8.DataGridView1.Rows.Count - 1
For j As Integer = 0 To Form8.DataGridView1.Columns.Count - 1
If cellRowIndex = 1 Then
worksheet.Cells(cellRowIndex, cellColumnIndex) = Form8.DataGridView1.Columns(j).HeaderText
Else
worksheet.Cells(cellRowIndex, cellColumnIndex) = Form8.DataGridView1.Rows(i).Cells(j).Value.ToString()
End If
cellColumnIndex += 1
Next
cellColumnIndex = 1
cellRowIndex += 1
Next
End If
Dim saveDialog As New SaveFileDialog()
saveDialog.FileName = workbook.Name
saveDialog.Filter = "Excel files (*.xlsx)|*.xlsx|All files (*.*)|*.*"
saveDialog.FilterIndex = 1
If saveDialog.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
workbook.SaveAs(saveDialog.FileName)
MessageBox.Show("Export Successful")
End If
End Sub
It is very difficult to understand what you are trying to do. From what I can decipher, there appears to be three (3) different WindowsForms open. The main active form has a Button and a CheckedListBox. The two other forms (Form7, Form8) each have a DataGridView with some data.
I assume that the CheckListBox allows the user to select which form to use when exporting to Excel. Example, if the user checks the first option, then clicks the button, then the DataGridView on Form7 will be exported to the Excel workbook. If the second option is checked then Form8’s DataGridView will be exported to the same workbook.
I hope I have this correct. To help, I would recommend you break the problem down into smaller pieces. Example, looking at the code in both “if” statements that check for a checked state in the checked list box… it is clear they are doing the same thing. The only difference is the DataGridView and the name of the worksheet.
It looks like a method, that took a workbook to add the sheet to, a DataGridView to export and finally a string for the worksheet name… might come in handy.
Private Sub AddGridToWorkbook(workbook As Workbook, dgv As DataGridView, sheetName As String)
This method would add a new worksheet to the given workbook using the given sheetName as the name for the new worksheet. Lastly the method would loop through the given DataGridView and export the values to the new worksheet.
The current posted code is trying to print the header row inside the loop through the grids rows. This will miss the first row of data. The header row for the new excel worksheet needs to be exported separately and outside the loop through the grids rows.
Lastly, I am curious what Form7 and Form8 are… If these are WindowsForm “Classes”… then the statement:…
worksheet.Cells(cellRowIndex, cellColumnIndex) = Form7.DataGridView1.Rows(i).Cells(j).Value.ToString()
This will not work as you expect… Form7 is a “Class” and you are using it like an instantiated object.
In my example below, I have two WindowsForms “Classes” called “Form7” and “Form8”. When the main form loads, I instantiate and show these two forms. Example: create the global variable forms.
Dim form7 As Form7 = New Form7()
Dim form8 As Form8 = New Form8()
Then show the forms on load.
form7.Show()
form8.Show()
Now the previous line of code will work using the instantiated “Form7” object named form7.
worksheet.Cells(cellRowIndex, cellColumnIndex) = form7.DataGridView1.Rows(i).Cells(j).Value.ToString()
Revised code to export the grids
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
excel.Visible = True
Dim workbook = excel.Workbooks.Add()
If CheckedListBox1.GetItemChecked(0) = True Then
AddGridToWorkbook(workbook, form7.DataGridView1, "Anim_Check List_")
End If
If CheckedListBox1.GetItemChecked(1) = True Then
AddGridToWorkbook(workbook, form8.DataGridView1, "Edits 1-5_")
End If
Dim saveDialog As New SaveFileDialog()
saveDialog.FileName = workbook.Name
saveDialog.Filter = "Excel files (*.xlsx)|*.xlsx|All files (*.*)|*.*"
saveDialog.FilterIndex = 1
If saveDialog.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
workbook.SaveAs(saveDialog.FileName)
MessageBox.Show("Export Successful")
End If
End Sub
Private Sub AddGridToWorkbook(workbook As Workbook, dgv As DataGridView, sheetName As String)
Try
Dim worksheet As Worksheet = workbook.Worksheets.Add()
worksheet.Name = sheetName
AddHeaderRow(worksheet, dgv)
For row As Integer = 0 To dgv.Rows.Count - 1
For col As Integer = 0 To dgv.Columns.Count - 1
If dgv.Rows(row).Cells(col).Value IsNot Nothing Then
worksheet.Cells(row + 2, col + 1) = dgv.Rows(row).Cells(col).Value.ToString()
End If
Next
Next
Catch ex As Exception
MessageBox.Show("Ex: " + ex.Message)
End Try
End Sub
Private Sub AddHeaderRow(worksheet As Worksheet, dgv As DataGridView)
For col As Integer = 0 To dgv.Columns.Count - 1
worksheet.Cells(1, col + 1) = dgv.Columns(col).HeaderText
Next
End Sub
Hope this helps

Limiting number of items that can be move from one Listbox to another

I would like to move no more than 8 selected items from Listbox1 to Listbox2. Both Listboxes are multi-select. When I select more than 8 items and move them at once to Listbox2, these items are not removed from Listbox1. However, the items are removed from Listbox1 when I move them individually, with exception of the item number 8.
The code works well if I don’t try to limit the number of items that can be moved but I'm having difficulty getting it to work with the specified condition (only 8 items in Listbox2).
I looked around on-line but couldn't find a good example. I would really appreciate advice. I also would like to know if what I'm trying to do is not possibile.
Private Sub BTN_MoveSelectedRight_Click()
Dim iCtr As Long
For iCtr = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(iCtr) = True And Not ListBox2.ListCount = 8 Then
Me.ListBox2.AddItem Me.ListBox1.List(iCtr)
End If
Next iCtr
For iCtr = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(iCtr) = True And Not ListBox2.ListCount = 8 Then
Me.ListBox1.RemoveItem iCtr
End If
Next iCtr
End Sub
ListBox.ListCount returns the number of items in your Listox. If you want to obtain the number of selected items, then you'd need this kind of function:
Private Function SelectedCount(lbox As msforms.ListBox) As Integer
Dim i As Integer
Dim sel As Integer
For i = 0 To lbox.ListCount - 1
If lbox.Selected(i) Then sel = sel + 1
Next
SelectedCount = sel
End Function
If you wanted to, you could keep track of selections and whenever the user selected a ninth item, unselect the oldest item. This way your ListBox would always have the eight (or fewer) most recently selected items. You could do that like so:
Option Explicit
Private mEnableUserEvents As Boolean
Private mSelectionOrder As Collection
Private Sub ListBox1_Change()
Dim key As String
If Not mEnableUserEvents Then Exit Sub
key = CStr(ListBox1.ListIndex)
If ListBox1.Selected(ListBox1.ListIndex) Then
mSelectionOrder.Add ListBox1.ListIndex, CStr(ListBox1.ListIndex)
If mSelectionOrder.Count = 9 Then
mEnableUserEvents = False
ListBox1.Selected(mSelectionOrder.Item(1)) = False
mEnableUserEvents = True
mSelectionOrder.Remove 1
End If
Else
mSelectionOrder.Remove key
End If
End Sub
Private Sub UserForm_Initialize()
mEnableUserEvents = True
Set mSelectionOrder = New Collection
End Sub
This code will move first 8 selected items from listbox1 to listbox2 and if listbox2 have 8 items will do nothing, I don't know if that is what you need.
Private Sub BTN_MoveSelectedRight_Click()
Dim iCtr As Long
Dim i As Long
Dim j As Long
Dim arr(8) As Long
For iCtr = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(iCtr) = True And Not ListBox2.ListCount = 8 Then
Me.ListBox2.AddItem Me.ListBox1.List(iCtr)
arr(i) = iCtr
i = i + 1
End If
If i = 8 Then Exit For
Next iCtr
For j = i - 1 To 0 Step -1
Me.ListBox1.RemoveItem arr(j)
Next
End Sub

VBA-Sorting the data in a listbox, sort works but data in listbox not changed

A listbox is passed, the data placed in an array, the array is sort and then the data is placed back in the listbox. The part that does work is putting the data back in the listbox. Its like the listbox is being passed by value instead of by ref.
Here's the sub that does the sort and the line of code that calls the sort sub.
Private Sub SortListBox(ByRef LB As MSForms.ListBox)
Dim First As Integer
Dim Last As Integer
Dim NumItems As Integer
Dim i As Integer
Dim j As Integer
Dim Temp As String
Dim TempArray() As Variant
ReDim TempArray(LB.ListCount)
First = LBound(TempArray) ' this works correctly
Last = UBound(TempArray) - 1 ' this works correctly
For i = First To Last
TempArray(i) = LB.List(i) ' this works correctly
Next i
For i = First To Last
For j = i + 1 To Last
If TempArray(i) > TempArray(j) Then
Temp = TempArray(j)
TempArray(j) = TempArray(i)
TempArray(i) = Temp
End If
Next j
Next i ! data is now sorted
LB.Clear ! this doesn't clear the items in the listbox
For i = First To Last
LB.AddItem TempArray(i) ! this doesn't work either
Next i
End Sub
Private Sub InitializeForm()
' There's code here to put data in the list box
Call SortListBox(FieldSelect.CompleteList)
End Sub
Thanks for your help.
This works for me on Excel 2003 on a very basic UserForm with a single ListBox called ListBox1:
Private Sub UserForm_Initialize()
ListBox1.AddItem "john"
ListBox1.AddItem "paul"
ListBox1.AddItem "george"
ListBox1.AddItem "ringo"
SortListBox ListBox1
End Sub
and then your SortListBox as written apart from fixing the three comments which start with ! rather than '
The only difference to your initializer is the name (UserForm_Initialize vs InitializeForm). Make sure to use the object and event selectors at the top of the code page for the userform to ensure that the event handlers get named correctly
You can't pass objects by value. Since you're not going to return another instance of listbox to the caller, you should declare LP as ByVal. That does not affect the code though. It works and the list gets sorted. I think you omitted some importand details.
Here is how I used this, for example, w/ a relational Dictionary and two columns:
Private Sub UserForm_Initialize()
Call HideTitleBar(Me)
Set ExtraFiltersDic = CreateObject("scripting.dictionary")
ExtraFiltersDic.CompareMode = 1
Set ExtraFiltersDic = GetExtraFiltersDic()
Dim k
For Each k In ExtraFiltersDic.Keys
ListBox1.AddItem k
Next
Call SortListBox(ListBox1, ListBox2, ExtraFiltersDic)
End Sub
Public Sub SortListBox(ByRef ListBox As MSForms.ListBox, Optional ByRef ListBox2 As MSForms.ListBox, Optional ByRef RelationalDic As Object)
Dim First As Integer, Last As Integer, NumItems As Integer
Dim i As Integer, j As Integer
Dim TempArray() As Variant, Temp As String
ReDim TempArray(ListBox.ListCount)
First = LBound(TempArray)
Last = UBound(TempArray) - 1
For i = First To Last
TempArray(i) = ListBox.List(i)
Next i
For i = First To Last
For j = i + 1 To Last
If TempArray(i) > TempArray(j) Then
Temp = TempArray(j)
TempArray(j) = TempArray(i)
TempArray(i) = Temp
End If
Next j
Next i
ListBox.Clear
If Not ListBox2 Is Nothing And Not RelationalDic Is Nothing Then
Set KeyValDic = CreateObject("scripting.dictionary")
Set KeyValDic = RelationalDic
End If
For i = First To Last
ListBox.AddItem TempArray(i)
If Not ListBox2 Is Nothing And Not RelationalDic Is Nothing Then
ListBox2.AddItem KeyValDic(TempArray(i))
End If
Next i
End Sub
I dont know if this would work for you but try it this way.
First, make an array of all the items in the list box
Pass that array to your function
Sort that array
return the array to the main program
clear the listbox
overwrite the listbox items with the new array

Resources