Stacking repeating grouped columns

rinconpaul · Aug 31st 2017

From the attachment:
The set out on Sheet1 down to row 9 is the way I record data. At the end of each day I need to copy and paste cols G:M; T:Z;AG:AM.........GQ:GW (haven't shown the full extent on the attachment) one on top of the other using the same cols A:D as an index (at left) on another sheet2. The length of the columns are always the same, but vary in total length each day. Appreciate some help with a macro. Color formatting isn't a requirement! Thanks

nyatiaju · Sep 1st 2017

Re: Stacking repeating grouped columns

Try this:

Code

Sub CopyData()
Dim sht1 As Worksheet, sht2 As Worksheet
Dim ConstantRng As Range
Dim lCol As Long, lRow As Long
Dim i As Long
Set sht1 = ThisWorkbook.Sheets("Sheet1")
Set sht2 = ThisWorkbook.Sheets("Sheet2")
Set ConstantRng = sht1.Range("C7:F9")
lCol = sht1.Cells(4, Columns.Count).End(xlToLeft).Column
lRow = sht2.Range("A" & Rows.Count).End(xlUp).Row + 1
If lCol < 7 Then Exit Sub
For i = 7 To lCol Step 13
    ConstantRng.Copy sht2.Range("A" & lRow)
    sht1.Range(Cells(7, i).Address, Cells(9, i + 6).Address).Copy sht2.Range("E" & lRow)
    lRow = sht2.Range("A" & Rows.Count).End(xlUp).Row + 1
Next i
End Sub

Display More

rinconpaul · Sep 1st 2017

Re: Stacking repeating grouped columns

nyatiaju, not working out! Usually happens when you upload a mini version of the actual work version. There are differences which might've thrown your code out? Here's the big picture spreadsheet. You must be close, a little further?
Thanks

nyatiaju · Sep 1st 2017

Re: Stacking repeating grouped columns

Please provide more information. Which data you want to collate from sheet 1 to sheet 2 on large file. Does constant range changes every day (in first file, it was on row 7 to 9), while in large file, it is on row 5.

**KjBox** · Sep 1st 2017

Re: Stacking repeating grouped columns

Try this

Code

Option Explicit


Sub CombineData()
    Dim x, y, z(), zz, i As Long, ii As Long, iii As Long, iv As Long, v As Long
    
    With Sheet1
        x = .Cells(7, 3).CurrentRegion.Resize(, 4)
        For i = 1 To .Rows(6).SpecialCells(2).Areas.Count
            y = .Rows(6).SpecialCells(2).Areas(i).Offset(1).Resize(UBound(x, 1), 8)
            If ii <> 0 Then v = UBound(z, 2)
            ii = ii + UBound(x, 1): ReDim Preserve z(1 To 12, 1 To ii)
            For iii = 1 To 4
                For iv = 1 To UBound(x, 1)
                    z(iii, v + iv) = x(iv, iii)
                Next
            Next
            For iii = 5 To 12
                For iv = 1 To UBound(y, 1)
                    z(iii, v + iv) = y(iv, iii - 4)
                Next
            Next
        Next
    End With
    zz = TransposeArray(z)
    With Sheet2
        .UsedRange.Offset(1).Clear
        .[a2].Resize(UBound(zz, 1), 12) = zz
        .Columns(1).Resize(, 5).AutoFit
        .Activate
    End With
    
End Sub


Private Function TransposeArray(Arr As Variant) As Variant
    Dim temp, a As Long, b As Long, i As Long, ii As Long
    i = UBound(Arr, 2): ii = UBound(Arr, 1)
    
    ReDim temp(1 To i, 1 To ii)
    
    For a = 1 To i
        For b = 1 To ii
            temp(a, b) = Arr(b, a)
        Next
    Next
    TransposeArray = temp
    
End Function

Display More

Your full file with above code working is attached

rinconpaul · Sep 1st 2017

Re: Stacking repeating grouped columns

Wow!! I'm just blown away by your mastery KjBox. You make it look so easy. Magnificent work. The auto "GIVE REPUTATION" won't allow me to award anymore stars to you, otherwise I'd give you 5 stars. Thanks for your help too nyatiaju.
:congrats:

**KjBox** · Sep 1st 2017

Re: Stacking repeating grouped columns

You're welcome.

rinconpaul · Mar 22nd 2018

To KjBox.
Back last September you helped me out. I adapted your code to work with my real time situation. Unfortunately my example wasn't truly representative and each day I use your macro I have to do some manual cleaning up to get it right. Not your fault though.
I've attached another example, I need to transpose groups of table data displayed horizontally and stack them vertically keeping common col A,B,C,D reference. The attached example shows sheet "Display1" as the current situation and sheet "Display2" the desired situation.
The real life scenario differs in that there are 14 tables horizontally, each with 12 headers. Some data in cells of tables will be blank! The row count for each "Event" varies and the number off. I'm wondering if you could redo your code to suit as I must say the advanced level of your previous code is beyond my comprehension/skill to amend?

Cheers as always [ATTACH]n1201336[/ATTACH]

**KjBox** · Mar 22nd 2018

Quote

The real life scenario differs in that there are 14 tables horizontally, each with 12 headers.

Your sample file shows 1 table with 22 headers.

Do you mean in reality you have 14 tables of 22 headers?

Can you convert those tables to Excel Built-in Tables rather than manually created tables?

rinconpaul · Mar 23rd 2018

Sorry Kj,
I call a table the contents of say cells E2:J6 or K2:P6 or Q7:V10. The real life scenario each one of these so called tables will have 12 headers and there will be 14 'tables' side by side using the same 'Event'. I coloured the cells to try and help differentiate? Hope this helps add to the confusion NOT?:chase:

rinconpaul · Mar 23rd 2018

There was a good pictorial of what I'm trying to achieve attached, but the solutions were beyond me: http:excel-inside.pro/blog/2015/11/16/stacking-non-nested-groups-of-repeating-columns-in-power-query/ [ATTACH=JSON]{"data-align":"none","data-size":"full","data-attachmentid":1201352}[/ATTACH]

rinconpaul · Mar 23rd 2018

Solved this with this code. it's rough and ready and not variable as in specifying number of rows. I've started a new thread to ask for help on that. I changed the sheet names in the example.

Code

Sub Pastytreat()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet


Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet2")


copySheet.Range("A2:D10").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


Sub LoopMacroPastytreat()
Dim x As Integer
For x = 1 To 3
Call Pastytreat
Next x
Call CandPFirst
Call CandPSecond
Call CandPThird
End Sub




Sub CandPFirst()
Dim n As Long
n = Worksheets("Sheet2").Cells(Rows.Count, "E").End(xlUp).Row + 1
Worksheets("Sheet1").Range("E2:J10").Copy Worksheets("Sheet2").Range("E" & n)


End Sub


Sub CandPSecond()
Dim n As Long
n = Worksheets("Sheet2").Cells(Rows.Count, "E").End(xlUp).Row + 1
Worksheets("Sheet1").Range("K2:P10").Copy Worksheets("Sheet2").Range("E" & n)
End Sub


Sub CandPThird()
Dim n As Long
n = Worksheets("Sheet2").Cells(Rows.Count, "E").End(xlUp).Row + 1
Worksheets("Sheet1").Range("Q2:V10").Copy Worksheets("Sheet2").Range("E" & n)
End Sub

Display More

Stacking repeating grouped columns

Participate now!

Share

Users Viewing This Thread