Append data on the first 4 columns with the adjacent columns

[whyjaydee]

Hello everyone,

I basically need help making this happen.
Is it possible to append the data on my columns A B C D with the data on the columns E F G H and so on.

Basically, the data looks like this when extracted (sample image attached)

I'd like to keep the headers in row 1 and add another column for the date which is currently on row 2 and will have a Date as header.
Each column under Security should append the Security column on column A and so on and basically end up with a total of 5 columns (Security, Low End of Risk Range, High end of Risk Range, Recent Price and Date)

I hope it makes sense

 

[Peter_SSs]

Better for next time:
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

See if this does what you want. Test with a copy of your data.

Sub StackColumns()
  Dim c As Long
  Dim rng As Range
  
  Application.ScreenUpdating = False
  Columns("A:E").Insert
  For c = 6 To 5 + Range("F1").CurrentRegion.Columns.Count Step 4
    Set rng = Range(Cells(3, c), Cells(Rows.Count, c).End(xlUp)).Resize(, 4)
    rng.Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
    Range("E" & Rows.Count).End(xlUp).Offset(1).Resize(rng.Rows.Count).Value = Cells(2, c).Value
  Next c
  Range("F1").Resize(, 4).Copy Destination:=Range("A1")
  Range("E1").Value = "Date"
  Application.ScreenUpdating = True
End Sub

 

[whyjaydee]

Better for next time:
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

See if this does what you want. Test with a copy of your data.

Sub StackColumns()
  Dim c As Long
  Dim rng As Range
 
  Application.ScreenUpdating = False
  Columns("A:E").Insert
  For c = 6 To 5 + Range("F1").CurrentRegion.Columns.Count Step 4
    Set rng = Range(Cells(3, c), Cells(Rows.Count, c).End(xlUp)).Resize(, 4)
    rng.Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
    Range("E" & Rows.Count).End(xlUp).Offset(1).Resize(rng.Rows.Count).Value = Cells(2, c).Value
  Next c
  Range("F1").Resize(, 4).Copy Destination:=Range("A1")
  Range("E1").Value = "Date"
  Application.ScreenUpdating = True
End Sub

Hi Peter,

Thank you for letting me know about the XL2BB tool and where to test it.

The code seems to be working fine, I just need additional code maybe where it should delete all other columns after copying all the data leaving just the 5 columns and the rest should be empty.

Thanks!

 

[Peter_SSs]

I just need additional code maybe where it should delete all other columns after copying all the data leaving just the 5 columns and the rest should be empty.

Sub StackColumns()
  Dim c As Long
  Dim rng As Range
  
  Application.ScreenUpdating = False
  Columns("A:E").Insert
  For c = 6 To 5 + Range("F1").CurrentRegion.Columns.Count Step 4
    Set rng = Range(Cells(3, c), Cells(Rows.Count, c).End(xlUp)).Resize(, 4)
    rng.Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
    Range("E" & Rows.Count).End(xlUp).Offset(1).Resize(rng.Rows.Count).Value = Cells(2, c).Value
  Next c
  Range("F1").Resize(, 4).Copy Destination:=Range("A1")
  Range("E1").Value = "Date"
  ActiveSheet.UsedRange.Offset(, 5).EntireColumn.Delete
  Application.ScreenUpdating = True
End Sub

 

[whyjaydee]

I tried editing the code and change to .cut instead of .copy but it leaves all the dates and the headers from other columns.

 

[whyjaydee]

Sub StackColumns()
  Dim c As Long
  Dim rng As Range
 
  Application.ScreenUpdating = False
  Columns("A:E").Insert
  For c = 6 To 5 + Range("F1").CurrentRegion.Columns.Count Step 4
    Set rng = Range(Cells(3, c), Cells(Rows.Count, c).End(xlUp)).Resize(, 4)
    rng.Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
    Range("E" & Rows.Count).End(xlUp).Offset(1).Resize(rng.Rows.Count).Value = Cells(2, c).Value
  Next c
  Range("F1").Resize(, 4).Copy Destination:=Range("A1")
  Range("E1").Value = "Date"
  ActiveSheet.UsedRange.Offset(, 5).EntireColumn.Delete
  Application.ScreenUpdating = True
End Sub

Works perfectly!! Amazing! Thank you so much Peter.

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.