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:
Code:
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:
Code:
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
