Load filtered data to listbox instead of worksheet

[kelly mort]

Hello, I want to find out if this code below here can be made to load the data into a listbox instead of pasting it to the sheet. My knowledge is limited with the how. Thanks in advance.

Sub FilterDates()
  Dim rCrit As Range  
  Sheets("HOME").UsedRange.ClearContents
  With Sheets(“DATA”).UsedRange
    Set rCrit = .Offset(, .Columns.Count).Resize(2, 1)
    rCrit.Cells(2).Formula = "=SEARCH(TEXT(C2,""dd""),F2)"
    '.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
    .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rCrit, copytorange:=Sheets("HOME").Range("B1"), Unique:=False
  End With
  rCrit.Cells(2, 1).ClearContents
End Sub

 

[Yongle]

Amend reference to listbox as required

Sub FilterDates()
    Dim rCrit As Range
    Sheets("HOME").UsedRange.ClearContents
    With Sheets("DATA").UsedRange
        Set rCrit = .Offset(, .Columns.Count).Resize(2, 1)
        rCrit.Cells(2).Formula = "=SEARCH(TEXT(C2,""dd""),F2)"
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
    End With
    rCrit.Cells(2, 1).ClearContents
[COLOR=#006400][I]'empty and re-populate Listbox[/I][/COLOR]
    With [COLOR=#ff0000]Sheets("SheetName").ListBox1[/COLOR]
        Do While .ListCount > 0
            .RemoveItem 0
        Loop
        .List = Sheets("Data").UsedRange.SpecialCells(xlCellTypeVisible).Value
    End With
End Sub

 

[kelly mort]

I did these amendment to fit my work. But it is not getting me the actual result needed. The rows 1 to 6 are all headers . The actual data starts from row 7 (A7). And I am trying to filter all January dates hence that ""01"" . Let me know if I am doing something wrongly.

Sub FilterDates()
    Dim rCrit As Range
    With Sheets("DATA").UsedRange
        Set rCrit = .Offset(, .Columns.Count).Resize([B]7[/B][COLOR=#333333], 1)[/COLOR][COLOR=#333333]
[/COLOR]        rCrit.Cells([B]7[/B]).Formula = [B]"=SEARCH(TEXT(""01"",""mm""),A7)"[/B]
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
    End With
    rCrit.Cells([B]7[/B], 1).ClearContents
[COLOR=#006400][I]'empty and re-populate Listbox[/I][/COLOR]
    With [COLOR=#ff0000]Sheets("SheetName").ListBox1[/COLOR]
        Do While .ListCount > 0
            .RemoveItem 0
        Loop
        .List = Sheets("Data").UsedRange.SpecialCells(xlCellTypeVisible).Value
    End With
End Sub

 

[kelly mort]

Also the listbox is loading the data with different format than how my data looks in the database. I tried using ".Text" instead of ".Value" but didn't work.

For example my dates are in the form "dd-mm-yy" but it's loading "dd-mmm-yy".

 

[Yongle]

This works with my test data

Sub FilterDates()
    Dim rCrit As Range, rng As Range, r As Long, c As Long, LBox As OLEObject
    Sheets("HOME").UsedRange.ClearContents
    Set rng = Sheets("DATA").UsedRange
    Set LBox = [I][COLOR=#ff0000]Sheets("SheetName").OLEObjects("ListBox1")[/COLOR][/I]
    
    With rng
        Set rCrit = .Offset(, .Columns.Count).Resize(2, 1)
        rCrit.Cells(2).Formula = "=SEARCH(TEXT(C2,""dd""),F2)"
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
    End With
    rCrit.Cells(2, 1).ClearContents
[I][COLOR=#006400]'empty and re-populate listbox[/COLOR][/I]
    With LBox.Object
        Do While .ListCount > 0
            .RemoveItem 0
        Loop
        Set rng = rng.Offset(6).Resize(rng.Rows.Count - 6, .ColumnCount)      [I] [COLOR=#006400] 'takes no of columns from ListBox[/COLOR][/I]
        Set rng = rng.SpecialCells(xlCellTypeVisible)
        .List = rng.Value
            For r = 0 To .ListCount - 1
                For c = 0 To .ColumnCount - 1
                  .List(r, c) = rng.Cells(r + 1, c + 1).Text
                Next c
            Next r
    End With
End Sub

 

[kelly mort]

This works with my test data

Sub FilterDates()
    Dim rCrit As Range, rng As Range, r As Long, c As Long, LBox As OLEObject
    Sheets("HOME").UsedRange.ClearContents
    Set rng = Sheets("DATA").UsedRange
    Set LBox = [I][COLOR=#ff0000]Sheets("SheetName").OLEObjects("ListBox1")[/COLOR][/I]
    
    With rng
        Set rCrit = .Offset(, .Columns.Count).Resize(2, 1)
        rCrit.Cells(2).Formula = "=SEARCH(TEXT(C2,""dd""),F2)"
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
    End With
    rCrit.Cells(2, 1).ClearContents
[I][COLOR=#006400]'empty and re-populate listbox[/COLOR][/I]
    With LBox.Object
        Do While .ListCount > 0
            .RemoveItem 0
        Loop
        Set rng = rng.Offset(6).Resize(rng.Rows.Count - 6, .ColumnCount)      [I] [COLOR=#006400] 'takes no of columns from ListBox[/COLOR][/I]
        Set rng = rng.SpecialCells(xlCellTypeVisible)
        .List = rng.Value
            For r = 0 To .ListCount - 1
                For c = 0 To .ColumnCount - 1
                  .List(r, c) = rng.Cells(r + 1, c + 1).Text
                Next c
            Next r
    End With
End Sub

Great! ! ! It's working fine. Actually the listbox is on a userform instead of a worksheet. I have fix that.


The only issue I have is that the formula I have there is not doing my intention. It's loading all the data into the listbox.

That code is a code I used for a different thing and I am trying to amend it to do a new thing but I think what I am thinking the code will do is far from what's doing.

This is how I want to filter the data:

rCrit.Cells([B]7[/B]).Formula = [B]"=SEARCH(TEXT(""01"",""mm""),B7)"

[/B]So from this formula I was hoping it will filter all dates in January from column B. I just had the impression that's different from the code is actually doing.

I wish this can be fixed. I am finding it challenging understanding this filtering thing.

 

[Yongle]

Dates are tricky to filter
- there are various ways to get there
- here is one method I use to filter between 2 dates

In example code below (which does not attempt to tie into your code)
- a valid date in cell D1 filters all dates in column B to display only those dates in same month and year as D1
- eg only January 2019 rows are visible if date in D1 is 7 Jan 2019
- do not amend the format of date text to local (US format works!)

Sub AutoFilter_All_Dates_For_Month()
    Dim Crit1 As String, Crit2 As String, cel As Range
    Set cel = Range("[COLOR=#ff0000]D1[/COLOR]")

    Crit1 = ">=" & Format(DateSerial(Year(cel), Month(cel), 1), "mm/dd/yyyy")           'first day of month of date in D1
    Crit2 = "<" & Format(DateSerial(Year(cel), Month(cel) + 1, 1), "mm/dd/yyyy")        'last day of month of date in D1
    
    Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=Crit1, Operator:=xlAnd, Criteria2:=Crit2
End Sub

 

[kelly mort]

Dates are tricky to filter
- there are various ways to get there
- here is one method I use to filter between 2 dates

In example code below (which does not attempt to tie into your code)
- a valid date in cell D1 filters all dates in column B to display only those dates in same month and year as D1
- eg only January 2019 rows are visible if date in D1 is 7 Jan 2019
- do not amend the format of date text to local (US format works!)

Sub AutoFilter_All_Dates_For_Month()
    Dim Crit1 As String, Crit2 As String, cel As Range
    Set cel = Range("[COLOR=#ff0000]D1[/COLOR]")

    Crit1 = ">=" & Format(DateSerial(Year(cel), Month(cel), 1), "mm/dd/yyyy")           'first day of month of date in D1
    Crit2 = "<" & Format(DateSerial(Year(cel), Month(cel) + 1, 1), "mm/dd/yyyy")        'last day of month of date in D1
    
    Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=Crit1, Operator:=xlAnd, Criteria2:=Crit2
End Sub

Cool! !! Very brilliant.

I love this, I will find a way to use some tricks in switching between years.


So now how do we get the filtered data into the listbox as before?

Then remove the filter.

Regards

 

[Yongle]

how do we .... remove the filter?

by using range variable rng (previously set earlier in the macro)

Add this at end of the code

On Error Resume Next
rng.Parent.ShowAllData

 

[kelly mort]

by using range variable rng (previously set earlier in the macro)

Add this at end of the code

On Error Resume Next
rng.Parent.ShowAllData

Cool!


Thanks for your patience