Consulting

Results 1 to 4 of 4

Thread: excel VBA - Listbox only populating one result!

  1. #1

    excel VBA - Listbox only populating one result!

    I dont usually add requests on here, but after trawling everywhere, I can't seem to find an answer and this really baffling me!
    I have a form that is populating data from a seperate spreadsheet which connects to a sharepoint site using a web query.
    My script filters the data and returns the results into a listbox.
    Everything seems to work fine, but when I filter two fields it will only return a single result and not the list of data. I have stepped through the code and it is filtering correctly, just not displaying the results.
    The most confusing thing is I have the exact same code with only one filter on a different page of the form that returns the data correctly.
    The working code is:

    Private Sub UpdateActiveButton_Click()
    
    Dim rngVis As Range
    
    Dim Lob As String
    Lob = LOBComboBox.Value
    
    Application.ScreenUpdating = False
    
    With Workbooks.Open("Data ssheet")
        With Sheets("Data")
    
        ActiveSheet.Unprotect
    Range("Table_owssvr").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
            .AutoFilterMode = False
    
    If Lob = "ALL CS" Then
    
    With Intersect(.UsedRange, .Range("A:CM"))
                .Sort Intersect(.Cells, .Parent.Columns("J")), xlAscending, Intersect    (.Cells, .Parent.Columns("A")), , xlAscending, Header:=xlGuess
                .AutoFilter Field:=10, Criteria1:=Array( _
        "CS", "CS2", "CS3"), Operator:=xlFilterValues
                On Error Resume Next
                Set rngVis = .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
                If Not rngVis Is Nothing Then Me.ActiveListBox.List = rngVis.Value
    
                ActiveListBox.ColumnWidths = "33;40;0;0;0;80;50;60;0;130"
            End With
    
    
    Else
    
    
    If Lob = "ALL MH&S" Then
    
    With Intersect(.UsedRange, .Range("A:CM"))
                .Sort Intersect(.Cells, .Parent.Columns("J")), xlAscending, Intersect    (.Cells, .Parent.Columns("A")), , xlAscending, Header:=xlGuess
                .AutoFilter Field:=10, Criteria1:=Array( _
        "MHS", "MHS2"), Operator:=xlFilterValues
                On Error Resume Next
                Set rngVis = .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
                If Not rngVis Is Nothing Then Me.ActiveListBox.List = rngVis.Value
    
                ActiveListBox.ColumnWidths = "33;40;0;0;0;80;50;60;0;130"
            End With
    
           End If        
    
    End With
        .Close False
    End With
    
    Application.ScreenUpdating = True
    
    End Sub
    This returns the full list in my listbox 'ActiveListBox', however the below code will only return the first result:

    Private Sub CommandButton10_Click()
    
    Dim rngVis2 As Range
    
    Dim Lob2 As String
    Lob2 = LOB2ComboBox.Value
    
    Application.ScreenUpdating = False
    
    With Workbooks.Open("data ssheet")
        With Sheets("Data")
    
        ActiveSheet.Unprotect
    Range("Table_owssvr").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
            .AutoFilterMode = False
    
    If Lob2 = "ALL CS" Then
    
    With Intersect(.UsedRange, .Range("Table_owssvr"))
                .Sort Intersect(.Cells, .Parent.Columns("J")), xlAscending, Intersect(.Cells, .Parent.Columns("A")), , xlAscending, Header:=xlGuess
                .AutoFilter Field:=10, Criteria1:=Array( _
                "CS", "CS2", "CS3"), Operator:=xlFilterValues
                .AutoFilter Field:=2, Criteria1:="Stage 4", Operator:=xlFilterValues
                On Error Resume Next
                Set rngVis2 = .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
    
                If Not rngVis2 Is Nothing Then Me.ActiveListBox2.List = rngVis2.Value
    
                ActiveListBox2.ColumnWidths = "33;40;0;0;0;80;50;60;0;130"
    
    End With
    
    Else
    
    
    If Lob2 = "ALL MH&S" Then
    
    With Intersect(.UsedRange, .Range("A:CM"))
                .Sort Intersect(.Cells, .Parent.Columns("J")), xlAscending, Intersect(.Cells, .Parent.Columns("A")), , xlAscending, Header:=xlGuess
                .AutoFilter Field:=10, Criteria1:=Array( _
        "MHS", "MHS2"), Operator:=xlFilterValues
               .AutoFilter Field:=2, Criteria1:="Stage 4", Operator:=xlFilterValues
                On Error Resume Next
                Set rngVis2 = .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
                If Not rngVis2 Is Nothing Then Me.ActiveListBox2.List = rngVis2.Value
    
                ActiveListBox2.ColumnWidths = "33;40;0;0;0;80;50;60;0;130"
            End With
    
            End If            
    
    End With
        .Close False
    End With
    
    Application.ScreenUpdating = True
    
    
    End Sub
    I'm really stuck with this and would really appreciate any help!!!
    Thanks Paul

  2. #2
    is there a reason why the range used in intersect is different?

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,645
    A non-contiguous range can't be loaded into a combobox/listbox.
    Only the first area will be loaded

    You can circumvent that problem by first copying the autofilter result to another range.
    That copied range will be contiguous.

      .Offset(1).copy cells(1,30) 
      Me.ActiveListBox2.List = cells(1,30).currentregion.value

  4. #4
    That's great!

    Thanks for your help!

    Paul

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •