Use Multiselect Listbox to find unselected items in table and delete those rows

[Russki]

Dear VBA Gurus,
Thank you in advance for taking a look at this.
I have a large data table with column V containing dates, many of which are duplicate. At this time I have a Multiselect Listbox that shows the unique dates from column V. The goal is to have user select one or more of those dates, and the have the code delete all the rows that do not have a matching date in column V as compared to those selected in the Listbox; so essentially the user selects the dates that need to be kept.
My understanding is that I need to have a dynamic array with the selected Listbox1 values, and then delete all rows that do not have values matching that array. I have found many examples of similar code, but all of them center around finding Strings, not dates or numbers.
The two key questions for me are:
1) What is the proper code to populate such an array with the items (dates) selected in the Listbox?
2) What would be the best example of the loop to run through my column V of the table and delete the rows that don’t match dates in array (items selected in Listbox)?
I am very appreciative of any examples. Thank you.

 

[Weaver]

Welcome to the board.

Is the listbox an activeX object embedded in a worksheet, or placed on a user form?

One way I might approach this would be to loop through the listbox and make an array of the non selected items, then use this to perform an advanced filter on the data, then delete all the visible rows. Once the filter is removed, what's left ought to be the data you're after.

 

[Russki]

Thank you Weaver.

The Listbox is within a UserForm.

Below is the code I used to attempt at making the array, but it seems to create a string array:

 Dim varList As Variant
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = False Then varList = varList & ListBox1.List(i)
Next i

What would be the best way to apply the array to the advance vilter?

Something else that I found that may potentially be another solution would use the loop and following statement:

if array value = cell value then blnFound = true 

Would that do any good? Either way, part of my challenge is applying the array to either the filter or to loop it through; can I please get a hint on that?

Thank you.

 

[Weaver]

What I'd do is create a new sheet, dump the list (including the relevant header) into this and then use the range of data (including the header) as an argument in the advanced filter. When you're done, you can delete the sheet you made.

I'm not convinced looping is the right way to go, but I think maybe you could make it work if you looped through the dates and did a countif with your list (using the ticked ones this time) as the range, since a zero return means the date isn't in there and you can delete the line. If you're doing it this way, remember to parse through your data from the bottom, otherwise your row counter gets thrown as the rows disappear.

 

[Weaver]

I've had a mess with this. If you're in the UK, you need to watch what you do with date formatting, so when you populate your listbox, use the .text property of the cell

Private Sub UserForm_Initialize()
    Dim rng As Range
    Me.ListBox1.Clear
    With ActiveSheet
        Set rng = .Range("D2", .Cells(Rows.Count, "D").End(xlUp))
    End With
    With CreateObject("Scripting.Dictionary")
        For Each r In rng.Cells
            If Not .exists(r.Text) Then .Add r.Text, 1
        Next r
        Me.ListBox1.List = WorksheetFunction.Transpose(.keys)
    End With
End Sub

Then when you want to dump the unticked items into a spreadsheet

Private Sub CommandButton1_Click()
    Dim cs As Worksheet, r As Long, dataRange As Range
    With ActiveSheet.Range("D1")
        h = .Value
        Set dataRange = .CurrentRegion
    End With
    Set cs = Sheets.Add
    cs.Range("A1") = h
    r = 2
    With Me.ListBox1
        For itm = 0 To .ListCount - 1
            If Not .Selected(itm) Then
                cs.Cells(r, 1).Value = DateValue(.List(itm))
                r = r + 1
            End If
        Next itm
    End With
    dataRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=cs.Range("A1").CurrentRegion, Unique:=False
    Application.DisplayAlerts = False
    cs.Delete
    Application.DisplayAlerts = True
    dataRange.Offset(1).EntireRow.Delete
    Cells.EntireRow.Hidden = False
    End With
End Sub

From there you can use the range created as the criteria range for your advanced filter.

 

[Weaver]

Delete the final 'end with' from the last bit of code - it'll error.

Also, it's not quite right, since the hidden rows don't reappear like they should - working on it.

 

[Weaver]

Got it - it was showAllData!

Private Sub CommandButton1_Click()
    Dim cs As Worksheet, r As Long, dr As Range
    Dim ds As Worksheet
    Set ds = ActiveSheet
    With ds.Range("D1")
        h = .Value
        Set dr = .CurrentRegion
    End With
    Set cs = Sheets.Add
    cs.Range("A1") = h
    r = 2
    With Me.ListBox1
        For itm = 0 To .ListCount - 1
            If Not .Selected(itm) Then
                cs.Cells(r, 1).Value = DateValue(.List(itm))
                r = r + 1
            End If
        Next itm
    End With
    dr.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=cs.Range("A1").CurrentRegion, Unique:=False
    Application.DisplayAlerts = False
    cs.Delete
    Application.DisplayAlerts = True
    dr.Offset(1).EntireRow.Delete
    ds.ShowAllData
    Unload Me
End Sub

 

[Russki]

Weaver - This is amazing, I am testing it out right now. Thank you so much, this type of assistance is ubelievable!!

I will respond if I have any questions.