Me.ListBox1.Clear produces Run time error '- 2147467259(80004005)': Unspecified error

Question

We have 4000 different materials/equipment in our stock.

We use a VBA stock macro, integrated with a barcode scanner, to make all the stock process.

We summarize all the different materials/equipment in another workbook separately thanks to VBA codes (let's say Summary Workbook).

To see how many different pipes and how many meters of pipes we have in our stock, you should click "PIPES" sheet inside of Summary Workbook.

For "ELECTRICAL MATERIALS", "FLANGES", "FITTINGS", "ASSETS" and the nearly 20 other stock groups it is the same.

All the titles are separated and they are all the different pages as a list.

Also I list all the titles ("ELECTRICAL MATERIALS", "FLANGES", "FITTINGS", "ASSETS", "PIPES" etc.) to another sheet (let's say DATA Sheet).

The main idea is: Use this sheet as a data list.

All the above operations purpose is checking materials/equipment quantity easily and how many different products we have in our stock. But when you open the "Summary Workbook" it is complicated to check. Every stock group includes at least 150 different materials/equipment.

So I created another sheet in Summary Workbook and named it Main Sheet. Besides, I created a textbox and a Listbox in it.

I choose all the stock information inside of the DATA sheet from (A2:F4214) and named them "DATA".
So when I choose the Listbox on the main sheet, I transfer all the "DATA"'s using "ListFillRange" method.

I use 6 columns with headings.

1- Number
2- Barcode No.
3- Stock Group Name
4- Stock Name
5- Stock Quantity
6- Stock Measurement (Meter, Piece, Set, Liter etc.)

Code to use textbox as a Search Box:

Private Sub TextBox1_Change()

Dim i As Long
Me.TextBox1.Text = StrConv(Me.TextBox1.Text, 1)
Me.ListBox1.Clear
For i = 2 To Application.WorksheetFunction.CountA(Sayfa281.Range("D:D"))
a = Len(Me.TextBox1.Text)
If Sayfa281.Cells(i, 4).Value Like "*" & TextBox1.Text & "*" Then
Me.ListBox1.AddItem Sayfa281.Cells(i, 4).Value
Me.ListBox1.List(ListBox1.ListCount - 1, 4) = Sayfa281.Cells(i, 4).Value
End If
Next i

End Sub

It gave:

Run time error '- 2147467259(80004005)':
Unspecified error.

When I click DEBUG, it shows Me.ListBox1.Clear in yellow.

When I used the above code inside of a user form it worked, but in an Excel sheet, it did not.

Answer 1

Based on the comments and this mrexcel.com link, it seems as if the 80004005 run-time error was due to the use of .ListFillRange to initialise the listbox, which was binding the listbox to a specific range in the workbook and making it "illegal" to remove any items from the listbox (either through .RemoveItem or .Clear).

If .ListFillRange is not used, the listbox's columns must be manually configured. Below is some code that can be used in the textbox's Change event handler to accomplish this. This code is a little generic so that it can be easily adjusted to any data sheet. A simpler version of this code would simply set the listbox's .ColumnWidths property to a hard-coded string, which would basically remove the need for all the code after Dim c as Long and before Me.ListBox1.Clear, but I believe that this code makes the listbox more flexible to changes in the source data sheet ...

Private Sub TextBox1_Change()
    'To avoid any screen update until the process is finished
    Application.ScreenUpdating = False
    'This method must make sure to turn this property back to True before exiting by
    '  always going through the exit_sub label

    On Error GoTo err_sub

    'This will be the string to filter by
    Dim filterSt As String: filterSt = Me.TextBox1.Text & ""

    'This is the number of the column to filter by
    Const filterCol As Long = 4 'This number can be changed as needed

    'This is the sheet to load the listbox from
    Dim dataSh As Worksheet: Set dataSh = Worksheets("DataSheet") 'The sheet name can be changed as needed

    'This is the number of columns that will be loaded from the sheet (starting with column A)
    Const colCount As Long = 6 'This constant allows you to easily include more/less columns in future

    'Determining how far down the sheet we must go
    Dim usedRng As Range: Set usedRng = dataSh.UsedRange
    Dim lastRow As Long: lastRow = usedRng.Row - 1 + usedRng.Rows.Count

    Dim c As Long

    'Getting the total width of all the columns on the sheet
    Dim colsTotWidth As Double: colsTotWidth = 0
    For c = 1 To colCount
        colsTotWidth = colsTotWidth + dataSh.Columns(c).ColumnWidth
    Next

    'Determining the desired total width for all the columns in the listbox
    Dim widthToUse As Double
    'Not sure why, but subtracting 4 ensured that the horizontal scrollbar would not appear
    widthToUse = Me.ListBox1.Width - 4
    If widthToUse < 0 Then widthToUse = 0

    'Making the widths of the listbox columns proportional to the corresponding column widths on the sheet;
    '  thus, the listbox columns will automatically adjust if the column widths on the sheet are changed
    Dim colWidthSt As String: colWidthSt = "" 'This will be the string used to set the listbox's column widths
    Dim totW As Double: totW = 0
    For c = 1 To colCount
        Dim w As Double
        If c = colCount Then 'Use the remaining width for the last column
            w = widthToUse - totW
        Else 'Calculate a proportional width
            w = dataSh.Columns(c).ColumnWidth / colsTotWidth * widthToUse
        End If

        'Rounding to 0 decimals and using an integer to avoid localisation issues
        '  when converting the width to a string
        Dim wInt As Long: wInt = Round(w, 0)
        If wInt < 1 And w > 0 Then wInt = 1
        totW = totW + wInt

        If c > 1 Then colWidthSt = colWidthSt & ","
        colWidthSt = colWidthSt & wInt
    Next

    'Reset the listbox
    Me.ListBox1.Clear
    Me.ListBox1.ColumnCount = colCount
    Me.ListBox1.ColumnWidths = colWidthSt
    Me.ListBox1.ColumnHeads = False

    'Reading the entire data sheet into memory
    Dim dataArr As Variant: dataArr = dataSh.UsedRange
    If Not IsArray(dataArr) Then dataArr = dataSh.Range("A1:A2")

    'If filterCol is beyond the last column in the data sheet, leave the list blank and simply exit
    If filterCol > UBound(dataArr, 2) Then GoTo exit_sub 'Do not use Exit Sub here, since we must turn ScreenUpdating back on

    'This array will store the rows that meet the filter condition
    'NB: This array will store the data in transposed form (rows and columns inverted) so that it can be easily
    '    resized later using ReDim Preserve, which only allows you to resize the last dimension
    ReDim filteredArr(1 To colCount, 1 To UBound(dataArr, 1)) 'Make room for the maximum possible size
    Dim filteredCount As Long: filteredCount = 0

    'Copy the matching rows from [dataArr] to [filteredArr]
    'IMPORTANT ASSUMPTION: The first row on the sheet is a header row
    Dim r As Long
    For r = 1 To lastRow
        'The first row will always be added to give the listbox a header
        If r > 1 And InStr(1, dataArr(r, filterCol) & "", filterSt, vbTextCompare) = 0 Then
            GoTo continue_for_r
        End If

        'NB: The Like operator is not used above in case [filterSt] has wildcard characters in it
        '    Also, the filtering above is case-insensitive
        '    (if needed, it can be changed to case-sensitive by changing the last parameter to vbBinaryCompare)

        filteredCount = filteredCount + 1
        For c = 1 To colCount
            'Inverting rows and columns in [filteredArr] in preparation for the later ReDim Preserve
            filteredArr(c, filteredCount) = dataArr(r, c)
        Next

continue_for_r:
    Next

    'Copy [filteredArr] to the listbox, removing the excess rows first
    If filteredCount > 0 Then
        ReDim Preserve filteredArr(1 To colCount, 1 To filteredCount)
        Me.ListBox1.Column = filteredArr
        'Used .Column instead of .List above, as per advice at
        '  https://stackoverflow.com/questions/54204164/listbox-error-could-not-set-the-list-property-invalid-property-value/54206396#54206396
    End If

exit_sub:
    Application.ScreenUpdating = True
    Exit Sub

err_sub:
    MsgBox "Error " & Err.Number & vbCrLf & vbCrLf & Err.Description
    Resume exit_sub 'To make sure that screen updating is turned back on
End Sub

If .ListFillRange is no longer being used, the listbox will be empty at the beginning and will be populated only after the user begins to type into the textbox. Currently, the entire data sheet will be loaded onto the listbox if the user edits and then clears the textbox, but that behaviour can be easily changed by adding If filterSt = "" Then GoTo exit_sub after the code block that resets the listbox.

The code tries to load the data more quickly by reading the entire data sheet into memory at the beginning instead of reading the data sheet one cell at a time. It also avoids using the listbox's .AddItem method in order to load the entire list at once and to bypass that method's 10-column limitation, as explained in this StackOverflow answer (the 10-column limitation can become an issue if the value of colCount is increased in future).

The code uses 2 arrays. The first array loads all the data sheet rows into memory, and the second array copies the rows that meet the filter condition. In the second array, the rows and columns are inverted so that it can be easily resized at the end using ReDim Preserve (after we know the final number of data rows to keep in the array). This transposition was needed because ReDim Preserve only allows you to resize the last dimension, as explained in this StackOverflow answer. Thanks, @T.M., for the advice at this StackOverflow answer!

Answer 2

for a beginner like me, you can not imagine how worthy your help is.

Thanks a lot.

Codes work well. I should ask you just a small thing too.

In every type of textbox, my Listbox getting smaller and smaller
the fact remains that pieces of information intertwine with each other.

I try to change some parameters below code,

   'Determining the desired total width for all the columns in the Listbox
    Dim widthToUse As Double
    'Not sure why, but subtracting 4 ensured that the horizontal scrollbar would not appear
    widthToUse = Me.ListBox1.Width - 4
    If widthToUse < 0 Then widthToUse = 0

    'Making the widths of the Listbox columns proportional to the corresponding column widths on the sheet;
    '  thus, the Listbox columns will automatically adjust if the column widths on the sheet are changed
    Dim colWidthSt As String: colWidthSt = "" 'This will be the string used to set the list box's column widths
    Dim totW As Double: totW = 0
    For c = 1 To colCount
        Dim w As Double
        If c = colCount Then 'Use the remaining width for the last column
            w = widthToUse - totW
        Else 'Calculate a proportional width
            w = dataSh.Columns(c).ColumnWidth / colsTotWidth * widthToUse
        End If

I could not achieve. Do you have any suggestions for this?

Have a good day.

Answer 3

For the listbox shrinkage bug, you can do the following.

    ListBox1.Width = 1000
    ListBox1.Height = 800

just before leaving the sub. It worked for me.

Answer 4

Thanks @macrobook and @NoahBridge.

Below code is works for me.

Private Sub TextBox1_Change()

   'To avoid any screen update until the process is finished
   Application.ScreenUpdating = False
   'This method must make sure to turn this property back to True before exiting by
   '  always going through the exit_sub label

   On Error GoTo err_sub

   'This will be the string to filter by
   Dim filterSt As String: filterSt = Me.TextBox1.Text & ""

   'This is the number of the column to filter by
   Const filterCol As Long = 4 'This number can be changed as needed

   'This is the sheet to load the listbox from
   Dim dataSh As Worksheet: Set dataSh = Worksheets("T?mListe") 'The sheet name can be changed as needed

   'This is the number of columns that will be loaded from the sheet (starting with column A)
   Const colCount As Long = 6 'This constant allows you to easily include more/less columns in future

   'Determining how far down the sheet we must go
   Dim usedRng As Range: Set usedRng = dataSh.UsedRange
   Dim lastRow As Long: lastRow = usedRng.Row - 1 + usedRng.Rows.Count

   Dim c As Long

   'Getting the total width of all the columns on the sheet
   Dim colsTotWidth As Double: colsTotWidth = 0
   For c = 1 To colCount
       colsTotWidth = colsTotWidth + dataSh.Columns(c).ColumnWidth
   Next

   'Determining the desired total width for all the columns in the listbox
   Dim widthToUse As Double
   'Not sure why, but subtracting 4 ensured that the horizontal scrollbar would not appear
   widthToUse = Me.ListBox1.Width - 4
   If widthToUse < 0 Then widthToUse = 0

   'Making the widths of the listbox columns proportional to the corresponding column widths on the sheet;
   '  thus, the listbox columns will automatically adjust if the column widths on the sheet are changed
   Dim colWidthSt As String: colWidthSt = "" 'This will be the string used to set the listbox's column widths
   Dim totW As Double: totW = 1
   For c = 1 To colCount
       Dim w As Double
       If c = colCount Then 'Use the remaining width for the last column
           w = widthToUse - totW
       Else 'Calculate a proportional width
           w = dataSh.Columns(c).ColumnWidth / colsTotWidth * widthToUse
       End If

       'Rounding to 0 decimals and using an integer to avoid localisation issues
       '  when converting the width to a string
       Dim wInt As Long: wInt = Round(w, 0)
       If wInt < 1 And w > 0 Then wInt = 1
       totW = totW + wInt

       If c > 1 Then colWidthSt = colWidthSt & ","
       colWidthSt = colWidthSt & wInt
   Next

   'Reset the listbox
   Me.ListBox1.Clear
   Me.ListBox1.ColumnCount = colCount
   Me.ListBox1.ColumnWidths = colWidthSt
   Me.ListBox1.ColumnHeads = False

   'Reading the entire data sheet into memory
   Dim dataArr As Variant: dataArr = dataSh.UsedRange
   If Not IsArray(dataArr) Then dataArr = dataSh.Range("A1:A2")

   'If filterCol is beyond the last column in the data sheet, leave the list blank and simply exit
   If filterCol > UBound(dataArr, 2) Then GoTo exit_sub 'Do not use Exit Sub here, since we must turn ScreenUpdating back on

   'This array will store the rows that meet the filter condition
   ReDim filteredArr(1 To UBound(dataArr, 1), 1 To UBound(dataArr, 2)) 'Make room for the maximum possible size
   Dim filteredCount As Long: filteredCount = 0

   'Copy the matching rows from [dataArr] to [filteredArr]
   'IMPORTANT ASSUMPTION: The first row on the sheet is a header row
   Dim r As Long
   For r = 1 To lastRow
       'The first row will always be added to give the listbox a header
       If r > 1 And InStr(1, dataArr(r, filterCol) & "", filterSt, vbTextCompare) = 0 Then
           GoTo continue_for_r
       End If

       'NB: The Like operator is not used above in case [filterSt] has wildcard characters in it
       '    Also, the filtering above is case-insensitive
       '    (if needed, it can be changed to case-sensitive by changing the last parameter to vbBinaryCompare)

       filteredCount = filteredCount + 1
       For c = 1 To colCount
           filteredArr(filteredCount, c) = dataArr(r, c)
       Next

continue_for_r:
   Next

   'Copy [filteredArr] to a new array with the right dimensions
   If filteredCount > 0 Then
       'Unfortunately, Redim Preserve cannot be used here because it can only resize the last dimension;
       '  therefore, we must manually copy the filtered data to a new array
       ReDim filteredArr2(1 To filteredCount, 1 To colCount)
       For r = 1 To filteredCount
           For c = 1 To colCount
               filteredArr2(r, c) = filteredArr(r, c)
           Next
       Next

       Me.ListBox1.List = filteredArr2
   End If

ListBox1.Height = 750
ListBox1.Width = 1800
ListBox1.Top = 100

exit_sub:
   Application.ScreenUpdating = True
   Exit Sub

err_sub:
   MsgBox "Error " & Err.Number & vbCrLf & vbCrLf & Err.Description
   Resume exit_sub 'To make sure that screen updating is turned back on
End Sub