Unpivot a table?

[darkangst]

Hi,

So my table for example looks like this:

Empl_ID	A2	A3	A4
11111	1	8	9
14044	2	9	9
14070	3	2	9
14167	4	2	9
14199	5	4	9
14210	6	7	9

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

I would like it to look like:

1111	1		A2
1111	8		A3
1111	9		A4
14044	2		A2
14044	9		A3
14044	9		A4
14070	3		A2
14070	2		A3
14070	9		A4
14167	4		A2
14167	2		A3
14167	9		A4
14199	5		A2
14199	4		A3
14199	9		A4
14210	6		A2
14210	7		A3
14210	9		A4

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

I was trying to use offset, indirect.. and got confused. I feel like this is simple but I just don't know how to do it. I still can't do this in reverse either haha.

 

[darkangst]

Oh sorry my ninja edit wasn't ninja enough. I forgot to select the headers and it came out weird. So how do I change the VBA based on the rows and columns that I have (which will vary with files?)

 

[alansidman]

Unless you show me your configuration, I cannot give you an answer as my crystal ball is broken.

 

[darkangst]

Thanks for your reply. I can't answer that specifically because each file is different ,some have 200 rows and 100 columns, some have 1000 rows and 5 columns for example. I just wanted to inquire how your VBA worked so I can tweak it as needed. I understand that you will not be able to manually adjust it for me. I will have 3 columns as an end result always.

 

[alansidman]

My bad, I misunderstood your request

The rows are already taken care of by the use of the lrS and lrT variables. You will need to add a line of code to Dim a new variable for the last column

 Dim lc as long
[TABLE="width: 19"]
<tbody>[TR]
[TD] lc=Cells(1,Columns.Count).End(xlToLeft).Column[/TD]
[/TR]
</tbody>[/TABLE]

Then where I have used the letter D to signify the right most column, you would use the variable lc.

Now you have a variable for both the last rows and the last column.

If you encounter more issues, then post back for clarification.

 

[alansidman]

Her's the new full code. I thought I better give it to you as there is a slight change in how to format the code when the last column is defined as an integer or long integer

Option Explicit


Sub UnPivot()
'Set your variables
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Dim i As Long
    Dim lrS As Long
    Dim lrT As Long
    Set w1 = Sheets("Sheet1")
    Set w2 = Sheets("Sheet2")
    lrS = w1.Range("A" & Rows.Count).End(xlUp).Row
    Dim lc As Long [COLOR=#ff0000]'new line[/COLOR]
    lc = Cells(1, Columns.Count).End(xlToLeft).Column [COLOR=#b22222]'new line[/COLOR]


Application.ScreenUpdating = False 'sets screen to update after all is completed so screen does not flutter
    With w1  'work within sheet1
        For i = 2 To lrS  'sets variable to select rows 2 to last row and loop
        lrT = w2.Range("B" & Rows.Count).End(xlUp).Row  'sets the last row in the target worksheet
            .Range("A" & i).Copy w2.Range("A" & lrT + 1) 'copies the range A and row i (variable) to new sheet and places in row after last row
            .Range(Cells(i, 2), Cells(i, lc)).Copy [COLOR=#b22222]'changed  [/COLOR]copies range B to last column in variable row[COLOR=#b22222][/COLOR]
            w2.Range("B" & lrT + 1).PasteSpecial xlPasteAll, , , True 'pastes to column B in target sheet
            .Range(Cells(1, 2), Cells(1, lc)).Copy [COLOR=#b22222]'changed [/COLOR]copies range  B1 to last column in row 1[COLOR=#b22222][/COLOR]
            w2.Range("C" & lrT + 1).PasteSpecial xlPasteAll, , , True 'pastes to column C in target sheet
        Next i
End With
Application.CutCopyMode = False




    With w2  'using the target sheet
    lrT = .Range("B" & Rows.Count).End(xlUp).Row  'finds last row used in column B
        For i = 3 To lrT 'Sets loop
        If .Range("A" & i) = "" Then  'if range A and variable row is empty 
            .Range("A" & i) = .Range("A" & i - 1) 'then copy the value in cell above and paste to it
        End If
        Next i
    End With
Application.ScreenUpdating = True
MsgBox "complete"


End Sub

 

[Trouttrap2]

??? I have no idea what this is doing, I added the entire page and selected 0 page fields is that right?

Don't add the page, but selecting 0 page fields is correct. Here is more detail:
Use ALT+D+P, select MULTIPLE CONSOLIDATION RANGES then PivotTable, click next. Select I WILL CREATE THE PAGE FIELDS, click next. Insert by highlighting the range of the matrix, Don't Add, select 0 page filds, click next, click new worksheet, click Finish. All those steps just gave you a pivot table, but if you double click the bottom right GRAND Total, that will generate the new table you want on another sheet.

Edit: This is where I learned it from some time ago. A short video by Mr. Excel. http://www.youtube.com/watch?v=kfWzkp92eEc
</SPAN>

 

[Mechixx]

Her's the new full code. I thought I better give it to you as there is a slight change in how to format the code when the last column is defined as an integer or long integer

Option Explicit


Sub UnPivot()
'Set your variables
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Dim i As Long
    Dim lrS As Long
    Dim lrT As Long
    Set w1 = Sheets("Sheet1")
    Set w2 = Sheets("Sheet2")
    lrS = w1.Range("A" & Rows.Count).End(xlUp).Row
    Dim lc As Long [COLOR=#ff0000]'new line[/COLOR]
    lc = Cells(1, Columns.Count).End(xlToLeft).Column [COLOR=#b22222]'new line[/COLOR]


Application.ScreenUpdating = False 'sets screen to update after all is completed so screen does not flutter
    With w1  'work within sheet1
        For i = 2 To lrS  'sets variable to select rows 2 to last row and loop
        lrT = w2.Range("B" & Rows.Count).End(xlUp).Row  'sets the last row in the target worksheet
            .Range("A" & i).Copy w2.Range("A" & lrT + 1) 'copies the range A and row i (variable) to new sheet and places in row after last row
            .Range(Cells(i, 2), Cells(i, lc)).Copy [COLOR=#b22222]'changed  [/COLOR]copies range B to last column in variable row
            w2.Range("B" & lrT + 1).PasteSpecial xlPasteAll, , , True 'pastes to column B in target sheet
            .Range(Cells(1, 2), Cells(1, lc)).Copy [COLOR=#b22222]'changed [/COLOR]copies range  B1 to last column in row 1
            w2.Range("C" & lrT + 1).PasteSpecial xlPasteAll, , , True 'pastes to column C in target sheet
        Next i
End With
Application.CutCopyMode = False




    With w2  'using the target sheet
    lrT = .Range("B" & Rows.Count).End(xlUp).Row  'finds last row used in column B
        For i = 3 To lrT 'Sets loop
        If .Range("A" & i) = "" Then  'if range A and variable row is empty 
            .Range("A" & i) = .Range("A" & i - 1) 'then copy the value in cell above and paste to it
        End If
        Next i
    End With
Application.ScreenUpdating = True
MsgBox "complete"


End Sub

I have a question about this code that i was wondering if you could answer.

if my data table starts in cell "C9" instead of "A1", how would this macro have to be adjusted to suit?