none
HELP Method of RemoveItem Object 'ListBox' Failed PLEASE RRS feed

  • Question

  • Add In/Excel VBA is throwing error Method of 'RemoveItem' of Object 'ListBox" failed upon hitting statement below (BOLDED)Add In works just fine in 2010.

    Worked before August 2016 in Microsoft Office 2016, but then Windows Updates broke something.

    This has been confirmed through research.

    You can open Add-In I 2016, but after dropping the necessary info into Download Tab and then Clicking "List Class Codes" Button Options Tab, that's where the problem occurs and I traced to code below.

    I would like to solve if possible without having to re-write a ton of code. This may be dirty and needs to be rewritten, but I just want it work as intended in 2010.

    **STATEMENT WHERE ERROR OCCURS:

    'Delete list
    ActiveSheet.ListBoxes(1).RemoveItem 1, ActiveSheet.ListBoxes(1).ListCount

    **GIST OF EXCEL ADD -IN:

    1) 6 tabs exist in add-in and are titled on tab as: Error Key, Download, Appendices, Options, Output, Combined Output.

    2) For this specific module, entire code is below, re: ListClassCodes() relevant data is on the:

    • DOWNLOAD tab Column D (headers always same, row number may be different depending on how many classes needing necessary information on). 
    • APPENDICES (For sake of this issue, we'll pretend this is blank so only Download tab is used for pulling data)
    • OPTIONS (LIST BOX 1 & 2 EXIST HERE - ERROR OCCURS ON ATTEMPTING CLICK OF "LIST CLASS CODES" BUTTON

    3)  A file is dropped into the Download tab  - the headers are always the same, but the amount of rows are not. Column D contains the numerical class codes that will be populated into an array into list box. Basically column D could have 10 or 10000 rows or more - in Column D, per row, you might see something like. All other columns/headers in Download tab aren't necessary in code below.

    92310
    92410
    92410
    92430
    92430
    92310
    92310
    84011
    92310
    92430
    92410
    92410
    92310
    92310
    92310
    92310
    92310
    92310
    92310
    92310

    4) The "LIST CLASS CODES" button starts process of pulling in the unique class codes shown in Download tab in Column D. It pulls them in and eventually sorts them in ascending order.  It is somewhere in this process that the 'RemoveItem' Method is failing in 2016 I hope someone can help me - this is driving me crazy.

    Sub ListClassCodes()
    Dim AllCells As Range, Cell As Range
    Dim NoDupes As New Collection
    Dim LastRow As Long
    Dim Found_ReportPN As Range, Found_MfgPN As Range
    
        If AddinName = "" Then
            AddinName = ActiveWorkbook.Name
        End If
    
    LastRow = Workbooks(AddinName).Worksheets("Download").Range("D1").End(xlDown).Row
    
    
    'clear Lists
    LstCount1 = ActiveSheet.ListBoxes(1).ListCount
    LstCount2 = ActiveSheet.ListBoxes(2).ListCount
    
    If LstCount1 <> 0 Then
        ActiveSheet.ListBoxes(1).RemoveItem 1, LstCount1
    End If
    If LstCount2 <> 0 Then
        ActiveSheet.ListBoxes(2).RemoveItem 1, LstCount2
    End If
    
    If Workbooks(AddinName).Worksheets("Download").Range("D2") > 0 Then
    
    'add items to NoDupes collection
    On Error Resume Next
    For Each Cell In Workbooks(AddinName).Worksheets("Download").Range("D2", "D" & LastRow)
        'Determine if current part is on an appendix
        Set Found_ReportPN = Workbooks(AddinName).Worksheets("Appendices").Range("A:Z").Find(Cell.Offset(0, 1).Value, lookat:=xlWhole)
        Set Found_MfgPN = Workbooks(AddinName).Worksheets("Appendices").Range("A:Z").Find(Cell.Offset(0, 2).Value, lookat:=xlWhole)
        
        'if the part is not on any appendix then add the class code to no dupes
        If Found_ReportPN Is Nothing And Found_MfgPN Is Nothing Then
            NoDupes.Add Cell.Value, CStr(Cell.Value)
        'else if the part is on an appendix, add that appendix to NoDupes
        ElseIf Not Found_ReportPN Is Nothing Then
            NoDupes.Add "Appendix " & Chr(Found_ReportPN.Column + 64), CStr(Found_ReportPN.Column)
        ElseIf Not Found_MfgPN Is Nothing Then
            NoDupes.Add "Appendix " & Chr(Found_MfgPN.Column + 64), CStr(Found_MfgPN.Column)
        End If
        
    Next Cell
    On Error GoTo 0
    
    'add the non-duplicated items to a ListBox
    For Each Item In NoDupes
    If Not (Item = 31100 Or Item = 31300) Then
        ActiveSheet.ListBoxes(1).AddItem Item
    End If
    Next Item
    
    'Sort List
    SortList1
    
    End If 'If Workbooks(AddinName).Worksheets("Download").Range("D2") > 0 Then
    End Sub
    
    Sub MoveCodesRight()
    Dim isDup As Boolean
    Dim i As Integer, m As Integer
    
    For i = 1 To ActiveSheet.ListBoxes(1).ListCount
        'if the value is selected then transfer to the second list
        If ActiveSheet.ListBoxes(1).Selected(i) Then
            'if 2nd list is blank add values
            If ActiveSheet.ListBoxes(2).ListCount = 0 Then
                ActiveSheet.ListBoxes(2).AddItem ActiveSheet.ListBoxes(1).List(i)
            Else 'else determine if value is or is not on the 2nd list
                isDup = False
                For j = 1 To ActiveSheet.ListBoxes(2).ListCount
                    'If the select value is currently not on the second list then add
                    If ActiveSheet.ListBoxes(1).List(i) = ActiveSheet.ListBoxes(2).List(j) Then
                        isDup = True
                        Exit For
                    End If
                Next j
                If isDup = False Then
                    ActiveSheet.ListBoxes(2).AddItem ActiveSheet.ListBoxes(1).List(i)
                End If
            End If
        End If
    Next i
    
    'sort list
    SortList2
    
    End Sub
    Sub MoveAllRight()
    Dim isDup As Boolean
    Dim i As Integer, m As Integer
    
    For i = 1 To ActiveSheet.ListBoxes(1).ListCount
            'if 2nd list is blank add values
            If ActiveSheet.ListBoxes(2).ListCount = 0 Then
                ActiveSheet.ListBoxes(2).AddItem ActiveSheet.ListBoxes(1).List(i)
            Else 'else determine if value is or is not on the 2nd list
                isDup = False
                For j = 1 To ActiveSheet.ListBoxes(2).ListCount
                    'If the select value is currently not on the second list then add
                    If ActiveSheet.ListBoxes(1).List(i) = ActiveSheet.ListBoxes(2).List(j) Then
                        isDup = True
                        Exit For
                    End If
                Next j
                If isDup = False Then
                    ActiveSheet.ListBoxes(2).AddItem ActiveSheet.ListBoxes(1).List(i)
                End If
            End If
    Next i
    'sort list
    SortList2
    End Sub
    
    Sub MoveAllLeft()
    m = 0
    For i = 1 To ActiveSheet.ListBoxes(2).ListCount
            ActiveSheet.ListBoxes(2).RemoveItem i - m
            m = m + 1
    Next i
    End Sub
    
    Sub MoveCodesLeft()
    m = 0
    For i = 1 To ActiveSheet.ListBoxes(2).ListCount
        If ActiveSheet.ListBoxes(2).Selected(i - m) Then
            ActiveSheet.ListBoxes(2).RemoveItem i - m
            m = m + 1
        End If
    Next i
    'sort list
    SortList2
    End Sub
    
    
    Sub SortList1()
    Dim storevalue() As String
    Dim m As Integer, NumItems
    
    NumItems = ActiveSheet.ListBoxes(1).ListCount
    ReDim storevalue(1 To ActiveSheet.ListBoxes(1).ListCount)
    
    'Store values in array and loop through each value
    For m = 1 To ActiveSheet.ListBoxes(1).ListCount
        storevalue(m) = ActiveSheet.ListBoxes(1).List(m)
    Next m
    
    'Delete list
    ActiveSheet.ListBoxes(1).RemoveItem 1, ActiveSheet.ListBoxes(1).ListCount
    
    'Add 1st item to list then loop throught the rest
    ActiveSheet.ListBoxes(1).AddItem storevalue(1)
    For m = 2 To NumItems
        For i = 1 To ActiveSheet.ListBoxes(1).ListCount
            'if less than current value then
            If storevalue(m) < ActiveSheet.ListBoxes(1).List(i) Then
                'shift values up one cell
                    q = ActiveSheet.ListBoxes(1).ListCount
                    For j = i To ActiveSheet.ListBoxes(1).ListCount
                        ActiveSheet.ListBoxes(1).List(q - j + i + 1) = ActiveSheet.ListBoxes(1).List(q - j + i)
                    Next j
                'Add the newest value at top of
                ActiveSheet.ListBoxes(1).List(i) = storevalue(m)
                Exit For
            ElseIf i = ActiveSheet.ListBoxes(1).ListCount Then  'if greater than the last value then add to end of list
                ActiveSheet.ListBoxes(1).AddItem storevalue(m)
                Exit For
            End If
        Next i
    Next m
    
    
    
    
    
    End Sub
    
    Sub SortList2()
    Dim storevalue() As String
    Dim m As Integer, NumItems
    
    NumItems = ActiveSheet.ListBoxes(2).ListCount
    
    If NumItems <> 0 Then
    
    ReDim storevalue(1 To ActiveSheet.ListBoxes(2).ListCount)
    
    
    'Store values in array and loop through each value
    For m = 1 To ActiveSheet.ListBoxes(2).ListCount
        storevalue(m) = ActiveSheet.ListBoxes(2).List(m)
    Next m
    
    'Delete list
    ActiveSheet.ListBoxes(2).RemoveItem 1, ActiveSheet.ListBoxes(2).ListCount
    
    'Add 1st item to list then loop throught the rest
    ActiveSheet.ListBoxes(2).AddItem storevalue(1)
    For m = 2 To NumItems
        For i = 1 To ActiveSheet.ListBoxes(2).ListCount
            'if less than current value then
            If storevalue(m) < ActiveSheet.ListBoxes(2).List(i) Then
                'shift values up one cell
                    q = ActiveSheet.ListBoxes(2).ListCount
                    For j = i To ActiveSheet.ListBoxes(2).ListCount
                        ActiveSheet.ListBoxes(2).List(q - j + i + 1) = ActiveSheet.ListBoxes(2).List(q - j + i)
                    Next j
                'Add the newest value at top of
                ActiveSheet.ListBoxes(2).List(i) = storevalue(m)
                Exit For
            ElseIf i = ActiveSheet.ListBoxes(2).ListCount Then  'if greater than the last value then add to end of list
                ActiveSheet.ListBoxes(2).AddItem storevalue(m)
                Exit For
            End If
        Next i
    Next m
    
    End If 'If NumItems <> 0 Then
    
    End Sub
    
    
    Sub UnselectAll()
    On Error Resume Next
    ActiveSheet.ListBoxes(1).Selected = False
    ActiveSheet.ListBoxes(2).Selected = False
    On Error GoTo 0
    End Sub
    


    • Edited by JMS1976 Sunday, February 19, 2017 2:39 PM
    Friday, February 17, 2017 6:21 PM

All replies

  • JMS,
    re:  Listboxes

    The Listboxes object is part of legecy code that MS has maintained.
    It is (was?) a hidden object in the VBE object browser. 
    I don't have xl2016 so as to check if it still exists after the latest update.

    What looks suspicious to me is your use of the second argument.
    '---
     Try replacing...
        ActiveSheet.ListBoxes(1).RemoveItem 1, ActiveSheet.ListBoxes(1).ListCount
     With...
        ActiveSheet.ListBoxes(1).RemoveItem 1
    '---

    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    Sunday, February 19, 2017 3:21 PM
  • Hi, James, Thanks for your reply. I think it is still a hidden object in VBE, but I do agree that line of code you mentioned stands out. I will try to comment it out and see if it frees my code up to run again without issue. I've messed with it a little but I just want it resolved. It's been giving me a headache for a couple weeks. Thanks Joyce
    Monday, February 20, 2017 12:14 AM
  • Hi,

    Could you please share your add-in file or some sample data here so that we could test your code and try to reproduce your issue.

    You could upload file into OneDrive and paste the shared URL here.

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, February 20, 2017 9:12 AM
    Moderator