Struggling With MultiSelect Userform Listboxes

[Ark68]

I am having trouble adapting my code to do what I need it to do. My Google searches hasn't provided me a clear understanding of what I need to do in my particular situiation.

I have a database that contains rows of data associated with different dates.
I have a listbox (lbx_datesel) on my userform that lists the different dates represented in the the database. This list is dynamic and can have one or more dates for the user to select.
The user selects one or more dates from the listbox.
When the user presses the SUBMIT button, I need the VBA to create a unique worksheet in the workbook to hold data exclusive to each date selected.
If three dates were selected, there would be three worksheets created (named: Core_Data_dd-mmm where dd and mm represents the day and month respectively of that selection being processed). Each worksheet would hold only the data for that selected date.

This is as far as I got ... and it doesn't work, for a single selection. Multiple selections are incomplete as I have no idea where to start.

Private Sub uf_proceed_Click()
    Dim cnt As Long
    Dim selectedRows As Collection
    Dim selval, t
    cnt = lbx_datesel.ListCount
    If cnt = 1 Then
        t = lbx_datesel.ListIndex
        selval = lbx_datesel.Value
        'eliminate all data from database other than what was selected.
        'rename data worksheet Core_Data_dd-mmm
    Else
        'multiselect
        'loop through all selected dates from listbox
        'copy data for that unique date to a new worksheet and name it Core_Data_dd-mmm
        'follow above procedure for each date selected from the list box
    End If
End Sub

Kindly asking for help or resources that can help me figure it out.

 

[Alex Blakenburg]

Given that you believe your dates are being stored as dates and not text in RMR1, try just replacing the line I have crossed out below with the 2 lines after it.

       'ws_rmr1.Range("A1").AutoFilter 1, Format(mydate, "mmm d, yyyy")
        ws_rmr1.Range("A1").AutoFilter field:=1, Criteria1:=">=" & CLng(mydate), _
             Operator:=xlAnd, Criteria2:="<" & CLng(mydate) + 1

 

[Ark68]

Hi Alex and Danet, I really appreciate all the help you provided. We endured a lot of frustration dealing with a couple issues with this particular process, and it really boiled down to inconsistency in dates. For this to work, I found that changing the dates in column A of the base data (rmr1.xlsx) complicated things to start. What I had to do to get back on the right path was not touch that data at all, and do all my filtering etc. based on text. So in addition to eliminating all text date conversions and formatting in my rmr1 clean code, I also rewrote the userform and listbox selection code. So far, it's working. I will do all my data cleaning (date formatting) in the worksheets that were created in the application workbook as part of the userform proceed code. I can close rmr1.xlsx to reduce having to jump back and forth.

It may not be pretty, and I'm sure it can be done a lot more efficient, but it works.

Private Sub uf_proceed_Click()
    Dim cnt As Long
    Dim selectedRows As Collection
    Dim t
    Dim c As Range, sh As Worksheet
    Dim i As Long
    Dim mydate As String, rw_md As Long, mydate3 As String
    Dim dt_mydate As Date
    Dim tb_name As String
    Dim nwsheet As Worksheet
   
    'cnt = lbx_datesel.ListCount
    For i = 0 To lbx_datesel.ListCount - 1
        If lbx_datesel.Selected(i) = True Then
            cnt = cnt + 1
        End If
    Next i
    With Me.lbx_datesel
        For i = 0 To cnt - 1
            If .Selected(i) = True Then
                mydate = lbx_datesel.List(i)
                dt_mydate = Application.WorksheetFunction.VLookup(mydate, ws_thold.Range("B:D"), 3, False)
                tb_name = "Core_Data_" & Format(dt_mydate, "dd-mmm")
                'ws_rmr1.Range("A1").AutoFilter 1, , xlFilterValues, Array(2, Format(mydate, "mm/dd/yyyy"))
                rw_md = WorksheetFunction.Match(mydate, ws_thold.Columns(2), 0)
                mydate3 = ws_thold.Cells(rw_md, 1)
                'ws_rmr1.Range("A1").AutoFilter 1, , xlFilterValues, Array(2, mydate3)
                ws_rmr1.Range("A1").AutoFilter field:=1, Criteria1:=mydate3 '
                Set nwsheet = wb_wsop.Sheets.Add '
                nwsheet.Name = "CoreData_" & Format(dt_mydate, "dd-mmm")
                ws_rmr1.AutoFilter.Range.EntireRow.Copy nwsheet.Range("A1")
                nwsheet.Visible = xlSheetHidden
            End If
        Next i
    End With
    ws_rmr1.Select
    ws_rmr1.ShowAllData
    Unload ufdateselect
    Application.DisplayAlerts = False
    wb_rmr1.Close
   
End Sub

 

[Alex Blakenburg]

Thanks for circling back and showing us what worked for you. Glad you got it sorted.