Table Manipulation

[lbird2]

Info1	Info2	Info3	Info4	Data1	Data2	Data3	Data4
A	1	Blue	Hot	0.4	0.5	1.3	2.7
B	2	White	Cold	2.3	0.1	1.5	8.1
C	3	Gold	Hot	2.6	7.1	6.1	0.8
D	4	Brown	Cold	0.9	2.6	2.3	1.1
E	1	White	Hot	0.1	0.6	2.3	2.0
F	7	Red	Cold	5.2	1.0	8.1	5.1
G	2	Purple	Cold	1.6	0.1	4.0	3.5

<tbody>
</tbody>

I find I need to do this often so I'm looking for a way to automate. I would like to repeat the "Info" rows and move each of the "Data" values to a single column of data. The table below shows what the result would be for the first two "Data" columns.

I get data in this format often and find the converted table to be much more flexible for analysis.

To make matters harder, the number of Info and Data items vary so I would like to account for that.

Any help would be greatly appreciated and would make my life a lot less tedious.

Info1	Info2	Info3	Info4	Data
A	1	Blue	Hot	0.4
B	2	White	Cold	2.3
C	3	Gold	Hot	2.6
D	4	Brown	Cold	0.9
E	1	White	Hot	0.1
F	7	Red	Cold	5.2
G	2	Purple	Cold	1.6
A	1	Blue	Hot	0.5
B	2	White	Cold	0.1
C	3	Gold	Hot	7.1
D	4	Brown	Cold	2.6
E	1	White	Hot	0.6
F	7	Red	Cold	1.0
G	2	Purple	Cold	0.1

<tbody>
</tbody>

 

[MickG]

Try this for results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG08Jun12
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] St [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Cells(1).CurrentRegion
St = 1
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2) - 4, 1 To 5)
[COLOR="Navy"]For[/COLOR] Ac = 5 To UBound(Ray, 2)
    col = col + 1
    St = IIf(c = 0, 1, 2)
    [COLOR="Navy"]For[/COLOR] n = St To UBound(Ray, 1)
        c = c + 1
        [COLOR="Navy"]For[/COLOR] Ac2 = 1 To 4
            nray(c, Ac2) = Ray(n, Ac2)
            nray(c, 5) = Ray(n, Ac)
        [COLOR="Navy"]Next[/COLOR] Ac2
     [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Ac
Sheets("Sheet2").Range("A1").Resize(c, 5).Value = nray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[jkpieterse]

Get and transform helps tremendously here, just convert to table, click from table and choose the right unpivot feature from the transformation tab. You either select the info columns or the data columns before choosing either unpivot columns or unpivot other columns.

 

[lbird2]

Thanks Mick. This works great but if I add another "Info" column, it does not catch it.
It works fine if I add additional "Data" columns.

I would have no problem editing the macro as needed to account for more "Info" columns. Which line do I edit to do that?

Thanks again it's a neat little macro.

 

[MickG]

The code should catch any column and row within the "CurrentRegion"
If you have a complete blank row or blank column at the end of your data that's where the Current region will end.
So is there a blank column between you basic data and the "Info Column".???

Maybe you can show an Example of your data with the "info column "

 

[lbird2]

If I add additional "Data" columns they get picked up nicely but if I add an additional "Info" column (say Info5 between Info4 and Data1), it gets ignored. Hope that makes sense.

I think the Get Transform may solve a lot of issues but I can't install the addon due to firewall issues at the workplace.

 

[MickG]

Please show an example with expected results.

 

[lbird2]

Example 1:
BEFORE

Info1	Info2	Info3	Info4	Data1	Data2	Data3	Data4
A	1	Z	Hot	2.3	1.5	0.8	7.4
B	2	Y	Cold	2.3	1.5	0.8	7.4
C	3	X	Hot	2.3	1.5	0.8	7.4
D	4	W	Cold	2.3	1.5	0.8	7.4
E	5	V	Hot	2.3	1.5	0.8	7.4
F	6	U	Cold	2.3	1.5	0.8	7.4
G	7	T	Hot	2.3	1.5	0.8	7.4

<colgroup><col width="64" span="8" style="width:48pt"> </colgroup><tbody>
</tbody>

AFTER

Info1	Info2	Info3	Info4	Data
A	1	Z	Hot	2.3
B	2	Y	Cold	2.3
C	3	X	Hot	2.3
D	4	W	Cold	2.3
E	5	V	Hot	2.3
F	6	U	Cold	2.3
G	7	T	Hot	2.3
A	1	Z	Hot	1.5
B	2	Y	Cold	1.5
C	3	X	Hot	1.5
D	4	W	Cold	1.5
E	5	V	Hot	1.5
F	6	U	Cold	1.5
G	7	T	Hot	1.5
A	1	Z	Hot	0.8
B	2	Y	Cold	0.8
C	3	X	Hot	0.8
D	4	W	Cold	0.8
E	5	V	Hot	0.8
F	6	U	Cold	0.8
G	7	T	Hot	0.8
A	1	Z	Hot	7.4
B	2	Y	Cold	7.4
C	3	X	Hot	7.4
D	4	W	Cold	7.4
E	5	V	Hot	7.4
F	6	U	Cold	7.4
G	7	T	Hot	7.4

<colgroup><col width="64" span="5" style="width:48pt"> </colgroup><tbody>
</tbody>

Example 2:

BEFORE

Y1	Y2	Y3	Y4	Y5	Y6	Data A	Data B
1990	A	Fall	North	UofM	Alpha	5	8
1991	B	Summer	East	MSU	Alpha	5	8
1992	C	Winter	North	CMU	Alpha	5	8

<colgroup><col width="64" span="8" style="width:48pt"> </colgroup><tbody>
</tbody>

AFTER

Y1	Y2	Y3	Y4	Y5	Y6	Data
1990	A	Fall	North	UofM	Alpha	5
1991	B	Summer	East	MSU	Alpha	5
1992	C	Winter	North	CMU	Alpha	5
1990	A	Fall	North	UofM	Alpha	8
1991	B	Summer	East	MSU	Alpha	8
1992	C	Winter	North	CMU	Alpha	8

<colgroup><col width="64" span="7" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[lbird2]

I installed the Power Query addon and was able to do what I wanted. Thanks all!

 

[jkpieterse]

This should work in all cases, provided your data columns always start with the word data:

Option Explicit

Sub StartUnpivotData()
    Dim oSource As Range
    Dim oTarget As Range
    On Error Resume Next
    Set oSource = Application.InputBox("Please select the source data", "Unpivot tool, source data", ActiveCell.CurrentRegion.Address, , , , , 8)
    If Not oSource Is Nothing Then
        Set oTarget = Application.InputBox("Please select where you want the result to go", "Unpivot tool, target location", , , , , , 8)
        If Not oTarget Is Nothing Then
            On Error GoTo 0
            Unpivot oSource, oTarget
        End If
    End If
End Sub

Sub Unpivot(oSource As Range, oTarget As Range)
    Dim vData As Variant
    Dim vNewData() As Variant

    Dim lRow As Long
    Dim lCol As Long
    Dim lNewRow As Long
    Dim lNewCol As Long

    Dim lInfoColCt As Long
    Dim lDataColCt As Long
    Dim bDataFound As Boolean
    vData = oSource.Value2
    'Get # of info columns
    For lInfoColCt = 1 To UBound(vData, 2)
        If LCase(vData(1, lInfoColCt)) Like "data*" Then
            bDataFound = True
            Exit For
        End If
    Next
    If bDataFound Then
        lInfoColCt = lInfoColCt - 1
        lDataColCt = UBound(vData, 2) - lInfoColCt

        ReDim vNewData(1 To lDataColCt * (UBound(vData, 1)), 1 To lInfoColCt + 1)
        For lCol = 1 To lInfoColCt
            vNewData(1, lCol) = vData(1, lCol)
        Next
        lNewRow = 1
        vNewData(1, lInfoColCt + 1) = "Data"
        For lRow = 2 To UBound(vData, 1)
            For lNewCol = 1 To lDataColCt
                lNewRow = lNewRow + 1
                For lCol = 1 To lInfoColCt
                    vNewData(lNewRow, lCol) = vData(lRow, lCol)
                Next
                vNewData(lNewRow, lInfoColCt + 1) = vData(lRow, lInfoColCt + lNewCol)
            Next
        Next
        oTarget.Resize(UBound(vNewData, 1), UBound(vNewData, 2)).Value2 = vNewData
    Else
        MsgBox "Unable to find any data columns"
    End If
End Sub