View Full Version : Solved: Filtered results to userform listbox problems!
Simon Lloyd
02-08-2008, 05:12 AM
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
02-08-2008, 05:41 AM
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
02-08-2008, 05:44 AM
You're Autofilter seems wrong also
rng.AutoFilter Field:=1, Criteria1:=Format(inDate, rng.Cells(2, 1).NumberFormat)
Simon Lloyd
02-08-2008, 05:47 AM
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
02-08-2008, 05:52 AM
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
02-08-2008, 05:52 AM
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
02-08-2008, 06:05 AM
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
02-08-2008, 06:10 AM
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.
Bob Phillips
02-08-2008, 06:13 AM
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
02-08-2008, 06:30 AM
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
02-08-2008, 06:32 AM
Rory thanks yours worked every bit as perfect as Bob's
Bob Phillips
02-08-2008, 10:06 AM
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
02-08-2008, 10:16 AM
:) thnx for taking the time to explain oh great one!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.