Export ListBox contents to new workbook via CommandButton

[HArce]

Hello,

I'm having difficulty coming up with vba to copy the filtered contents in a multi-column listbox "ListBox1" to a new workbook. I would like to achieve this via CommandButton "Export" located in UserForm frmAAGReport". Can anyone offer some insight?

P.S. - I would attach a sample workbook but can not find where I can include an attachment. Not sure if it's because I'm a new member.

Thank you.

 

[tlowry]

Welcome to Mr.Excel!

Some more information is necessary:

I'm having difficulty coming up with vba to copy the filtered contents in a multi-column listbox "ListBox1" to a new workbook. I would like to achieve this via CommandButton "Export" located in UserForm frmAAGReport". Can anyone offer some insight?

1. Do you want all the contents of the ListBox, or just the selected items?
2. Is the Listbox on the form, or a worksheet?
3. Did you mean new workbook or new worksheet and do you want to name the new workbook (or worksheet)?
4. Where on the target worksheet do you want the items to go?
5. https://www.box.com/ is a file sharing location you can use.

 

[HArce]

Welcome to Mr.Excel!

Some more information is necessary:



1. Do you want all the contents of the ListBox, or just the selected items?
2. Is the Listbox on the form, or a worksheet?
3. Did you mean new workbook or new worksheet and do you want to name the new workbook (or worksheet)?
4. Where on the target worksheet do you want the items to go?
5. https://www.box.com/ is a file sharing location you can use.

Thanks for your response, tlowry. I'll try to address your questions in the same order below.
1. I've already setup a filter via another command button to filter specific information which displays in the listbox. Hence, filtered information displayed in the listbox is ideal.
2. The listbox is located in a userform titled "frmAAGReport"
3. I meant in a brand new workbook, though a new worksheet would also work.
4. The items can be listed starting on Cell A1 in the same format it is displayed in the source.
5. Thanks for this information. I'll try to upload it and provide a link here.

Thank you.

 

[HArce]

Here is a link to a sample workbook. http://www.box.com/s/2e4n4dg4xi63900yxlte Thanks!

 

[tlowry]

This is what I think you want...

Put this code in the form's module for the CommandButton1

Private Sub CommandButton1_Click()
   With Workbooks.Add
        .Sheets(1).Range(Cells(1, 1), Cells(Me.ListBox1.ListCount, Me.ListBox1.ColumnCount)) = _
            Me.ListBox1.List
        Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
    End With
End Sub

 

[HArce]

Thank you, tlowry! The code works very well. A couple of questions though: (1) would it be possible to maintain the same format as the source and (2) can the header row transfer to the new workbook? Thanks!

 

[tlowry]

Having a header row is an important bit of information. Here's the new code:

Private Sub CommandButton1_Click()
    Dim rng: Set rng = Range(Me.ListBox1.RowSource)
    Select Case Me.ListBox1.ColumnHeads
        Case True
            Range(Cells(rng.Row - 1, rng.Column).Address & ":" & _
                            rng.Cells.SpecialCells(xlCellTypeLastCell).Address).Copy
        Case Else
            rng.Copy
        End Select
    With Workbooks.Add
        Cells(1, 1).PasteSpecial xlAll
        Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
    End With
End Sub

 

[HArce]

Having a header row is an important bit of information. Here's the new code:

Private Sub CommandButton1_Click()
    Dim rng: Set rng = Range(Me.ListBox1.RowSource)
    Select Case Me.ListBox1.ColumnHeads
        Case True
            Range(Cells(rng.Row - 1, rng.Column).Address & ":" & _
                            rng.Cells.SpecialCells(xlCellTypeLastCell).Address).Copy
        Case Else
            rng.Copy
        End Select
    With Workbooks.Add
        Cells(1, 1).PasteSpecial xlAll
        Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
    End With
End Sub

Thanks, tlowry. I'm having a problem with the code this time around. When the data transfers over to the new workbook, the cells where the data should be are highlighted in black and the data does not transfer. Any idea what might be causing this to happen? Thanks again!

 

[HArce]

I took a screenshot of what the export looks like and uploaded it to Box.com. Please see below.

https://www.box.com/s/45dor3r15j6k46pqhukw

Thanks.

 

[tlowry]

Well, this is getting a bit more complicated.

I think the problem is that the code (that would be me) made an assumption that the data (without headers, or formatting) were in the active sheet. Here's an update:

Private Sub CommandButton1_Click()
    Dim aSheet, aWind
    Set aWind = ThisWorkbook
    Set aSheet = ActiveSheet
    Sheets(Range(Me.ListBox1.RowSource).Parent.Name).Activate
    Dim rng: Set rng = Range(Me.ListBox1.RowSource)
    Select Case Me.ListBox1.ColumnHeads
        Case True
            Range(Cells(rng.Row - 1, rng.Column).Address & ":" & _
                            rng.Cells.SpecialCells(xlCellTypeLastCell).Address).Copy
        Case Else
            rng.Copy
        End Select
    Dim oW
    Set oW = Workbooks.Add
    Cells(1, 1).PasteSpecial xlAll
    Sheets(1).Name = Format(Now(), "yyyy-mm-dd") & " Transfer"
    Cells(1, 1).Select
    aWind.Activate
    Application.CutCopyMode = False
    aSheet.Activate
    oW.Activate
    
End Sub