Copy and paste of multiple columns into one stacked column - Need to be able to select a specific column to which to stack

[wiscochris]

Hi, I found this awesome vba script here on the forum.

It does exacly what I need where it copies columns BV:BX of "1 - all" and combines them into one column on a separate sheet ("stacked") but it dumps the data into column "A".
I would like to be able to select which column the data gets dumped into so that I can run the script for other data sets and put them in the same "stacked" sheet.

I've tried chaning the column reference "A" to somting else but it does not work . I"m not familiar enough with VBA to solve this (I hope) simple issue.

Thanks in advance to anyone who can help me.

Sub Copy_Columns()
Application.ScreenUpdating = False
Dim i As Long
Dim lastRow As Long
lastRow = Sheets("1 - All").Cells(Rows.Count, "BV").End(xlUp).Row
Dim Lastrowa As Long
With Sheets("stacked")
   Lastrowa = .Cells(Rows.Count, "a").End(xlUp).Row + 1
   .Cells(Lastrowa, 1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BV").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, "a").End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BW").End(xlUp).Row
   .Cells(Lastrowa, 1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BW").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, "a").End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BX").End(xlUp).Row
   .Cells(Lastrowa, 1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BX").Resize(lastRow).Value
   Lastrowa = .Cells(Rows.Count, "a").End(xlUp).Row + 1
   lastRow = Sheets("1 - All").Cells(Rows.Count, "BY").End(xlUp).Row
   .Cells(Lastrowa, 1).Resize(lastRow).Value = Sheets("1 - All").Cells(2, "BY").Resize(lastRow).Value
End With
Application.ScreenUpdating = True
End Sub

 

[wiscochris]

I understand, yeah, the screenshot thing is tough.

Here is an overview of what I am hoping to get your help with. Again, I really, really appreciate you time and expertise. This is a "fun" project that I have been playing around with, on and off for years and it's great to finally see it coming together.

Here is a breif video overview of what I am asking for, in case that helps.

Here is a One Drive link the file (module 5 is the vba script that I am running).

Thanks again.

 

[mumps]

The blank cells in column BY were causing a problem. Let's take this one step at a time. Start with a blank "stacked" sheet. Try this version of the macro:

Sub Copy_Columns_orginal_play()
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    'Remember time when macro starts
      StartTime = Timer
    '*****************************
    Application.ScreenUpdating = False
    Dim LastRow As Long, col As String, x As Long, y As Long: y = 1
    col = "A"
    LastRow = Sheets("1 - All").Cells(Rows.Count, "G").End(xlUp).Row - 1
    For x = 1 To 13
        With Sheets("stacked")
            .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
            y = y + LastRow
        End With
    Next x
    col = "C"
    y = 1
    With Sheets("stacked")
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BV").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BW").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BX").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BY").Resize(LastRow).Value
    End With
    y = y + LastRow
    With Sheets("stacked")
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DR").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DS").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DT").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DU").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DV").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DW").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DX").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DY").Resize(LastRow).Value
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DZ").Resize(LastRow).Value
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A1:A" & LastRow).Replace " - Google Search", "", xlPart, , False
    End With
    Application.ScreenUpdating = True
    'Determine how many seconds code took to run
      SecondsElapsed = Round(Timer - StartTime, 2)
    'Notify user in seconds
      MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub

If it works properly, please manually complete column B and column D to show the desired result and post a screenshot of the completed sheet. This will give me an idea of the code needed to complete columns B and D.

 

[wiscochris]

That works perfectly Thank you very much.

here is the updated spreadsheet. Your code is module 6. I changed the need from B & D to B & C. IF you scroll through the spreadsheet you can see the full dummy data in columns B & C.

here is a very short video describing what I am looking for. It's much easier to describe than to try to show you screenshots.

Thanks SO much for your help on this. I am not only getting these things done as I had hoped but also learning a ton.

 

[mumps]

Try:

Sub Copy_Columns_orginal_play()
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    'Remember time when macro starts
      StartTime = Timer
    '*****************************
    Application.ScreenUpdating = False
    Dim LastRow As Long, col As String, x As Long, y As Long: y = 1
    col = "A"
    LastRow = Sheets("1 - All").Cells(Rows.Count, "G").End(xlUp).Row - 1
    For x = 1 To 13
        With Sheets("stacked")
            .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "G").Resize(LastRow).Value
            y = y + LastRow
        End With
    Next x
    col = "D"
    y = 1
    With Sheets("stacked")
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BV").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 1
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BW").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 2
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BX").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 3
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "BY").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 4
        .Cells(1, 2).Resize(LastRow + y - 1).Value = "Local Pack"
        x = LastRow + y
    End With
    y = y + LastRow
    With Sheets("stacked")
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DR").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 1
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DS").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 2
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DT").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 3
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DU").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 4
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DV").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 5
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DW").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 6
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DX").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 7
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DY").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 8
        y = y + LastRow
        .Cells(y, col).Resize(LastRow).Value = Sheets("1 - All").Cells(2, "DZ").Resize(LastRow).Value
        .Cells(y, 3).Resize(LastRow).Value = 9
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("B" & x & ":B" & LastRow) = "Organic"
        .Range("A1:A" & LastRow).Replace " - Google Search", "", xlPart, , False
    End With
    Application.ScreenUpdating = True
    'Determine how many seconds code took to run
      SecondsElapsed = Round(Timer - StartTime, 2)
    'Notify user in seconds
      MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub

 

[wiscochris]

This is outstanding. I really enjoyed the process of trying to find solutions, testing and failing, and then seeing and understanding your solution. Great learning. Great result. Thanks very much!

 

[mumps]

You are very welcome.