Copying Data Pulled from a Listbox to a New Sheet

**JP777** · 04-27-2012, 08:50 PM

I have a spreadsheet that contains a lot of data in Sheet1, and I have a userform with two listboxes. the first listbox pulls in the column headings from Sheet1. the user can then choose which info to do something with, and move them to the second listbox. When the user clicks the ok button, I am creating a new worksheet and trying to match the column headings from the second listbox with their corresponding data and put the columns of data, including heading, in the new worksheet. Here is the code I have so far:

Private Sub OKButton_Click()

    Dim intLbxIndex As Integer    'ListBox (Lbx) index number
    Dim rngCell As Range
    Dim rngDigData As Range
    Dim iColumn As Long
   
    'add worksheet for digital data to be plotted and copy cycles to it
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Dig_Plot_Work"
    Sheet1.Select
    Sheet1.Range("A1", Range("A" & Rows.Count).End(xlUp)).Copy Sheets("Dig_Plot_Work").Range("A1")

    'add data from listbox to new worksheet
    For intLbxIndex = 0 To ListBox2.ListCount - 1
        For Each rngCell In Sheet1.Range("A1").CurrentRegion
            If (CStr(rngCell.Value) = CStr(ListBox2.List(intLbxIndex))) Then
                iColumn = rngCell.Column
                Set rngDigData = Range(Sheet1.Cells(2, iColumn), Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, iColumn).End(xlUp).Row, iColumn))
                'copy or transfer rngDigData data to "Dig_Plot_Work" sheet columns, starting with "B1"
            End If
        Next rngCell
    Next intLbxIndex

    Unload Me
End Sub

Can anyone help me with how I would go about actually getting the data to the new worksheet, "Dig_Plot_Work"? is my code that far off? I was thinking I may have everything except for the code that goes after Set rngDigData. I already have the code to plot the info once I get the data to the new worksheet. Thanks in advance for your help!

**JP777** · 04-27-2012, 09:11 PM

Here is the sample spreadsheet I'm working with in case it helps...

**protonLeah** · 04-27-2012, 11:08 PM

Try this one:

Private Sub OKButton_Click()
    Dim intLbxIndex As Long, _
        List2Count  As Long, _
        iColumn     As Long, _
        HeaderRow   As Range, _
        Header      As Range, _
        rngCell     As Range, _
        rngDigData  As Range, _
        ColHead     As String

    List2Count = ListBox2.ListCount - 1
    
    Set HeaderRow = Sheet1.Range("A1", Range(Cells(1, Columns.Count).End(xlToLeft).Address(0, 0)))
        
   
    'add worksheet for digital data to be plotted and copy cycles to it
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Dig_Plot_Work"
    
    Sheet1.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Copy Sheets("Dig_Plot_Work").Range("A1")
    
    'add data from listbox to new worksheet
    For intLbxIndex = 0 To List2Count
        ColHead = ListBox2.List(intLbxIndex)
        For Each Header In HeaderRow
            If ColHead = Header Then
                iColumn = iColumn + 1
                Sheet1.Range(Header.Address(0, 0), Sheet1.Cells(Rows.Count, Header.Column).End(xlUp).Address(0, 0)).Copy Sheets("Dig_Plot_Work").Range("A1").Offset(0, iColumn)
            End If
        Next Header
    Next intLbxIndex
    Unload Me
End Sub

**JP777** · 04-27-2012, 11:43 PM

protonLeah,
thanks for the post. everything worked except that the cycles values in column A of sheet 1 didn't make it to the new sheet. that's ok, though. I got it figured out. Thanks for your help!