Solved: Filtered results to userform listbox problems!

[Simon Lloyd]

Hi all attached is a small file which has a userform that when a date is chosen should show all the activities for that date in the listbox, however it is showing some very odd results!

Can anyone shed some light on why i cannot get single line report for each activity on the selected date one under the other in the listbox?

[Bob Phillips]

The call to the filter function fails because you are not passing a date, even with CDate, because the combobox is showing 05 Tue February 2008 for example, which just cannot be dated.

[Bob Phillips]

You're Autofilter seems wrong also



rng.AutoFilter Field:=1, Criteria1:=Format(inDate, rng.Cells(2, 1).NumberFormat)

[Simon Lloyd]

Hi Bob, i had tried having my date list in the xx/xx/xx format (and changed the notation for the combobox) but it still gave odd results!

BTW thanks for replying!

[Bob Phillips]

Option Explicit

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub ComboBox1_Change()
Dim rng As Range
Dim oRow As Range
Dim i As Long
ComboBox1.Value = Format(ComboBox1.Value, "dd mmmm yyyy")
ListBox1.Value = Format(ListBox1.Value, "[h]:mm") & ListBox1.Value = Format(ListBox1.Value, "hh:mm")

With Sheets("Sheet1")
On Error Resume Next
Set rng = Intersect(.Columns("A:G"), .UsedRange)
On Error GoTo 0
Set rng = FilterDate(CDate(Me.ComboBox1.Value))
For Each oRow In rng
Me.ListBox1.AddItem oRow.Cells(1, 1)
For i = 1 To 10
Me.ListBox1.List(Me.ListBox1.ListCount - 1, i - 1) = oRow.Cells(1, i)
Next i
Next oRow
End With
rng.AutoFilter

End Sub

Private Sub UserForm_Activate()
Dim oDates As Object
Dim i As Long
Dim aryDates
Dim cell, rng1 As Range
Set oDates = CreateObject("Scripting.Dictionary")
Set rng1 = Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
With ListBox1
.Value = Format(.Value, "[h]:mm") & .Value = Format(.Value, "hh:mm")
End With
On Error Resume Next
Application.ScreenUpdating = False
For Each cell In rng1

oDates.Add cell.Value, Format(cell.Value, "dd mmmm yyyy")
Next
Application.ScreenUpdating = True

aryDates = oDates.items

For i = 0 To oDates.Count - 1
ComboBox1.AddItem aryDates(i)
Next

End Sub

[Simon Lloyd]

I also had the amount of columns for the listbox set to 6 when it should be 9 but it still hasn't made any difference!

[Simon Lloyd]

Bob i tried the version you kindly posted, i now get the headings too! but the initial problem of not getting just the date i wanted filtered and placed in the listbox is still there and it also seems to have a cascaded effect of overunning information, and showing the times as decimals rather than times!

[Simon Lloyd]

The look i am trying to get is as per the worksheet if it had been filtered by date, because eventually this worksheet would be 000's of lines long.

[rory]

How's this?

[Bob Phillips]

Form



Option Explicit

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub ComboBox1_Change()
Dim rng As Range
Dim oRow As Range
Dim i As Long
ComboBox1.Value = Format(ComboBox1.Value, "dd mmmm yyyy")
ListBox1.Value = Format(ListBox1.Value, "[h]:mm") & ListBox1.Value = Format(ListBox1.Value, "hh:mm")

With Sheets("Sheet1")
On Error Resume Next
Set rng = Intersect(.Columns("A:G"), .UsedRange)
On Error GoTo 0
Set rng = FilterDate(CDate(Me.ComboBox1.Value))
For Each oRow In rng
Me.ListBox1.AddItem oRow.Cells(1, 1)
For i = 1 To 10
Me.ListBox1.List(Me.ListBox1.ListCount - 1, i - 1) = oRow.Cells(1, i).Text
Next i
Next oRow
End With
rng.AutoFilter

End Sub

Private Sub UserForm_Activate()
Dim oDates As Object
Dim i As Long
Dim aryDates
Dim cell, rng1 As Range
Set oDates = CreateObject("Scripting.Dictionary")
Set rng1 = Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
With ListBox1
.Value = Format(.Value, "[h]:mm") & .Value = Format(.Value, "hh:mm")
End With
On Error Resume Next
Application.ScreenUpdating = False
For Each cell In rng1

oDates.Add cell.Value, Format(cell.Value, "dd mmmm yyyy")
Next
Application.ScreenUpdating = True

aryDates = oDates.items

For i = 0 To oDates.Count - 1
ComboBox1.AddItem aryDates(i)
Next

End Sub


Module



Sub Button1_Click()
UserForm2.Show
End Sub

Function FilterDate(inDate As Date) As Range
Dim rng As Range
Dim LastRow As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range(.Range("B1"), .Range("B1").End(xlDown))
rng.AutoFilter
rng.AutoFilter Field:=1, Criteria1:=Format(inDate, rng.Cells(2, 1).NumberFormat)
Set FilterDate = .Range("B2").Resize(LastRow - 1).SpecialCells(xlCellTypeVisible).EntireRow
End With

End Function

[Simon Lloyd]

That was it Bob, thanks i've tried all sorts on this, can you possibly explain why i got the cascade effect?, the previous version worked perfect stepping through but not when run via the command button!

[Simon Lloyd]

Rory thanks yours worked every bit as perfect as Bob's

[Bob Phillips]

You are getting so much data becuase, as I said, the calle to the range filter is failing, so when you come to process the data, rng is setto all of the data. the complete $A$1:$G$22.

The loop then processes all of these 154 cells, not just the few that you are expecting in column B, and outputs the 10 cells on the row below (below because you use Cells(2 not Cells(1)).

[Simon Lloyd]

:) thnx for taking the time to explain oh great one!