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.

 

[DanteAmor]

Hello @Ark68 , thanks for posting on the forum.

It would be very, very helpful if you provide us with all the information to help us help you, such as:

- The name of the sheet where the data is.​

- In which column is the date.​

- In which row the dates start, etc...​

I provide you with a code assuming the name of the sheet. And I put cell A1 assuming the dates are in column A and the data starts in row 2. I hope from this point you can generate what you need.

Private Sub uf_proceed_Click()
  Dim c As Range, sh As Worksheet
  Dim i As Long
  Dim myDate
  
  Application.ScreenUpdating = False
  
  Set sh = Sheets("raw")                      'Fit to your sheet name
  With lbx_datesel
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then
        myDate = .List(i)
        sh.Range("A1").AutoFilter 1, , xlFilterValues, Array(2, Format(myDate, "mm/dd/yyyy")) 'Fit "A1" to date column
        Sheets.Add(, Sheets(Sheets.Count)).Name = "Core_Data_" & Format(myDate, "dd-mmm")
        sh.AutoFilter.Range.EntireRow.Copy Range("A1")
      End If
    Next
  End With
  sh.Select
  sh.ShowAllData
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

 

[Ark68]

Thank you Dante!
I am getting an error with the line in red. "Autofilter method of Range class failed"

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
    Dim tb_name As String
   
    cnt = lbx_datesel.ListCount
    If cnt = 1 Then
        t = lbx_datesel.ListIndex
        mydate = CDate(lbx_datesel.List(t))
        MsgBox Format(mydate, "dd-mmm-yyyy") '######
        tb_name = "Core_Data_" & Format(mydate, "dd-mmm")
        wb_rmr1.Worksheets("Sheet1").Copy after:=wb_wsop.Sheets(Sheets.Count)
        ActiveSheet.Name = tb_name
    Else 'allows user to process more than one date
        'https://www.mrexcel.com/board/threads/struggling-with-multiselect-userform-listboxes.1235796/
        With lbx_datesel
            For i = 0 To cnt - 1
                If .Selected(i) = True Then
                    mydate = .List(i)
                    ws_rmr1.Range("A1").AutoFilter 1, , xlFilterValues, Array(2, Format(mydate, "mm/dd/yyyy"))
                    Sheets.Add(, Sheets(Sheets.Count)).Name = "Core_Data_" & Format(mydate, "dd-mmm")
                    ws_rmr1.AutoFilter.Range.EntireRow.Copy Range("A1")
                End If
            Next i
        End With
        ws_rmr1.Select
        ws_rmr1.ShowAllData
    End If
End Sub

I think it's because myDate is different between the listbox selection and the data in the database. For example, the data in column A is text "Jul 8, 2023". The equivalent value in the listbox is "Saturday 08-Jul", also text.
The list rowsource is created using this code...

Sub clean_rmrl()
    Dim cntrmr1raw As Double
    Dim drow As Long 'destination row for date list
    Dim std As Long 'rows of raw rmr1
    Dim vl As String 'looped date value from raw rmr1
   
    With ws_rmr1
        cntrmr1raw = .Range("A" & .Rows.Count).End(xlUp).Row - 1
        If cntrmr1raw < 1 Then
            uf_caption = "RMR1 EMPTY"
            lb_msg1 = "rmr1.xlsx is empty of any records." & Chr(13) & "Access ActiveNet to recreate the file or [NOT NOW] to cancel."
        Else
            'create unique date list
            ws_thold.Columns("A:D").Clear
            drow = 1
            For std = 2 To cntrmr1raw + 1
                vl = .Cells(std, 1)
                If Application.WorksheetFunction.CountIf(ws_thold.Columns(1), vl) < 1 Then 'add to the list
                    ws_thold.Cells(drow, 1) = vl 'text date
                    ws_thold.Cells(drow, 2) = Format(DateValue(vl), "dddd  dd-mmm") 'true date conversion
                    drow = drow + 1 'advance destination row for next unique date value
                End If
            Next std
        End If
    End With

    drow = 1
    With ws_thold
        Do Until .Cells(drow, 1) = ""
            .Cells(drow, 3) = Application.WorksheetFunction.CountIf(ws_rmr1.Columns(1), .Cells(drow, 1))
            drow = drow + 1
        Loop
    End With
   
    'present user with list of dates to select from
    uf_dateselect.show
   
   
End Sub

Not sure what I need to match the values in the raw data (wb_rmr1.sheet1)

 

[Alex Blakenburg]

Try adding CDate to the preceding line:

                    mydate = CDate(.List(i))
                    ws_rmr1.Range("A1").AutoFilter 1, , xlFilterValues, Array(2, Format(mydate, "mm/dd/yyyy"))
                    Sheets.Add(, Sheets(Sheets.Count)).Name = "Core_Data_" & Format(mydate, "dd-mmm")

 

[DanteAmor]

I am getting an error with the line in red. "Autofilter method of Range class failed"

The problem may be that you have texts in the listbox, which are not dates. I do not know.


I also don't know how you loaded the data into listbox.
You have this line to open the userform, but you didn't put the code you have in the userform to load the data in the listbox, I don't know if you loaded column 1 or column 2 of your sheet.

'present user with list of dates to select from uf_dateselect.show

Because according to your code you have 2 columns with date:

ws_thold.Cells(drow, 1) = vl 'text date
ws_thold.Cells(drow, 2) = Format(DateValue(vl), "dddd dd-mmm") 'true date conversion

So, from your original post you must put all the information concerning your sheet, your form. If you already have code, you must put it, that would help us to identify your problem from the beginning and try to solve it. At this point I am blind and I could not give you an adequate answer, I would only be guessing to see if any option works for you.

Like I said, I don't know how your data is in your listbox, so I'm going to venture out to help you out.

Try the following, if it doesn't work for you, then put all the requested information here.
In your code I commented out the lines that are not needed.

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 Date
'    Dim tb_name As String
   
    'By the way, the If cnt is not necessary, the code that I gave you works for 1 or several.

'    cnt = lbx_datesel.ListCount
'    If cnt = 1 Then
'        t = lbx_datesel.ListIndex
'        mydate = CDate(lbx_datesel.List(t))
'        MsgBox Format(mydate, "dd-mmm-yyyy") '######
'        tb_name = "Core_Data_" & Format(mydate, "dd-mmm")
'        wb_rmr1.Worksheets("Sheet1").Copy after:=wb_wsop.Sheets(Sheets.Count)
'        ActiveSheet.Name = tb_name
'    Else 'allows user to process more than one date
'        'https://www.mrexcel.com/board/threads/struggling-with-multiselect-userform-listboxes.1235796/
  With lbx_datesel
    For i = 0 To lbx_datesel.ListCount - 1
      If .Selected(i) = True Then
        mydate = CDate(.List(i))
        ws_rmr1.Range("A1").AutoFilter 1, , xlFilterValues, Array(2, Format(mydate, "mm/dd/yyyy"))
        Sheets.Add(, Sheets(Sheets.Count)).Name = "Core_Data_" & Format(mydate, "dd-mmm")
        ws_rmr1.AutoFilter.Range.EntireRow.Copy Range("A1")
      End If
    Next i
  End With
  ws_rmr1.Select
  ws_rmr1.ShowAllData
'    End If
End Sub

The issue of dates is delicate, so it would also be convenient for you to share your file to test with your data and provide you with a reliable solution according to your needs.

Sincerely.
Dante Amor

 

[Ark68]

Hi Dante, I'm happy to see you're still on the case. Yes ... if there is one thing I struggle most with in Excel, is dates. I lose so much time in dealing with them. In fact, I discovered I was having what I thought was an unrelated problem with dates, so I looked to Mr. Excel for help with that. That issue around date formatting was very unusual and never was solved, and I have a strong suspision that that issue may have some bearing on what's going on here. That being said, that post, morphed into trying to solve this very problem. So, this has been essentially cross posted here. You might wish to have a look at that post and see if that changes your advice. It has my project files posted there to help solve this date issue out.

I've reposted my files here.

Core File (holds code)
Data FIle (RMR1)

 

[DanteAmor]

Hi @Ark68.

Your code has several problems, I could make a list of the problems you have in your code, but I'm going to focus on the solution, which is to properly apply the date you have in the listbox.

I show you below the evidence that the code to filter works correctly:

Below I list the characteristics of the code, according to the books that you attached:

1. The filter is done in the book "RMR1", in the sheet "Sheet1". Note: The RMR1 workbook must be open.​

2. The dates that are loaded in the listbox are in the workbook that contains the userform (ThisWorkbook).​

3. The new worksheets are created in the workbook that contains the userform (ThisWorkbook).​

4. The code should work in 2 books, which you didn't mention in your code or in your posts.​

5. Since you are not clear where you want the new sheets, I decided to create them in the workbook that contains the userform (ThisWorkbook).​

6. Special request, please, before you modify the code, before you take it to another book, before you rename the books or the sheets, I ask you to test the 2 books which I am attaching They are your same books, but in the uf_dateselect userform I put the updated code.​

7. If you modify the code without understanding what it is doing, you will have problems, and this thread will grow and grow, so I ask you to follow the instructions, once you understand how it works, then you can modify the code.​

8. I understand that you have other code in other modules, but I would have to go through all your code to get to the point of filtering by date. So I ask your consideration to test only the "uf_dateselect" userform and filter by date.​

The code:

Private Sub uf_proceed_Click()
  Dim wb1 As Workbook, wb2 As Workbook
  Dim i As Long, nRow As Long
  Dim mydate As Date
  Dim ws_rmr1 As Worksheet, ws_thold As Worksheet
  Dim sName As String
 
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
 
  Set wb1 = ThisWorkbook
  Set wb2 = Workbooks("RMR1")
 
  Set ws_thold = wb1.Sheets("THOLD")
  Set ws_rmr1 = wb2.Sheets("Sheet1")
 
  With lbx_datesel
    For i = 0 To lbx_datesel.ListCount - 1
      If .Selected(i) = True Then
        nRow = i + 1
        mydate = CDate(ws_thold.Range("A" & nRow).Value)
        ws_rmr1.Range("A1").AutoFilter 1, Format(mydate, "mmm d, yyyy")
        sName = "Core_Data_" & Format(mydate, "dd-mmm")
        On Error Resume Next: wb1.Sheets(sName).Delete: On Error GoTo 0
        wb1.Sheets.Add(, wb1.Sheets(wb1.Sheets.Count)).Name = sName
        ws_rmr1.AutoFilter.Range.EntireRow.Copy wb1.Sheets(sName).Range("A1")
      End If
    Next i
  End With
 
  ws_rmr1.ShowAllData

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
  Dim lrng As Range
  Dim lrow As Long
  Dim ws_thold As Worksheet
 
  Set ws_thold = ThisWorkbook.Sheets("THOLD")
  lrow = ws_thold.Range("B" & ws_thold.Rows.Count).End(xlUp).Row
  Set lrng = ws_thold.Range("B1:C" & lrow)
 
  With lbx_datesel
    .RowSource = lrng.Address(external:=True)
    .ColumnHeads = False
    .ColumnWidths = "105;28"
  End With
End Sub

The code contemplates the variables and objects for the 2 books, for the 2 sheets. Try the code as I'm putting it, sorry for being insistent, but if you don't, you'll have problems with the filter again. After the tests change what you want.

Last note, if you want the new sheets in book 2, change wb1 to wb2 on these lines and then try.

        On Error Resume Next: wb1.Sheets(sName).Delete: On Error GoTo 0
        wb1.Sheets.Add(, wb1.Sheets(wb1.Sheets.Count)).Name = sName
        ws_rmr1.AutoFilter.Range.EntireRow.Copy wb1.Sheets(sName).Range("A1")

Books attached:
Book with userform
RMR1 book

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------

 

[Ark68]

Thanks Dante, but I give up.
Your contributions didn't give me an error, but it filtered empty. Likely because the date values in column A of the data (rmr1.xlsx) was converted to a date value.

I rewrote my code to get rid of any date formatting or conversion of the text date in the data source. The date in column of A of rmr1.xlsx is text. Confirmed.
I am using your filter code to filter text date to text date and it comes up empty, just the header. I am comparing text data to text data as far as I know.

Thank you for your efforts.

 

[DanteAmor]

It's a shame it doesn't work for you, that's why I was quite specific that you follow my instructions, if you don't follow my instructions you're going to have problems.
You should have tried the files I shared. If you don't want to test with my files and you insist on continuing to modify the codes that I give you and testing with your data, it's like I warned you, this thread is going to get endless.

Even if I wanted to, it's hard to continue with my help, since you don't respect the instructions.

Sincerely.
Dante Amor

 

[Ark68]

I did try your files Dante, I said I did. No errors, but no filter either.
The files you provided, when ran, changed the date formats. You didn't see that did you? You code had an error in it that I had to change. I had to change the code to get rid of the lines that reformatted the dates so that I could have the same data as yours. I don't think you really looked at the whole application. Did you look at the issue I was having with the date formats that I mentioned from a previous post? The filter you provided was looking for a format that did not match. I think a filter will fail if you're trying to match a text date with a date value, which is what I truely believe to be the problem here.