modifying Un-Pivot Macro

[Tim Hanson]

Hello,

I got the un-pivot code here (the rewritten part of "snb’s approach") it is blazing fast.

The problem is that the range to unpivot is imputed with msgboxes and I am always un-pivoting the same table with different data in it so I would like to hard code the ranges asked for.

I have tryed but not getting it.

There is only the pivot table on the active sheet

The range of the headers to the LEFT not to be un-pivoted is col A to G

The range of header to the RIGHT to be un-pivoted is col H to last column

Below is that part of the code that ask for the prompts

Thank you

Sub UnPivot_snb()
Dim varSource As Variant
Dim j As Long
Dim m As Long
Dim n As Long
Dim i As Long
Dim varOutput As Variant
Dim rngCrossTab As Range
Dim rngLeftHeaders As Range
Dim rngRightHeaders As Range

'Identify where the ENTIRE crosstab table is
If rngCrossTab Is Nothing Then
On Error Resume Next
Set rngCrossTab = Application.InputBox( _
Title:="Please select the ENTIRE crosstab", _
prompt:="Please select the ENTIRE crosstab that you want to turn into a flat file", _
Type:=8, Default:=Selection.CurrentRegion.Address)
If Err.Number <> 0 Then
On Error GoTo errhandler
Err.Raise 999
Else: On Error GoTo errhandler
End If
rngCrossTab.Parent.Activate
rngCrossTab.Cells(1, 1).Select 'Returns them to the top left of the source table for convenience
End If

'Identify range containing columns of interest running down the table
If rngLeftHeaders Is Nothing Then
On Error Resume Next
Set rngLeftHeaders = Application.InputBox( _
Title:="Select the column HEADERS from the LEFT of the table that WON'T be aggregated", _
prompt:="Select the column HEADERS from the LEFT of the table that won't be aggregated", _
Default:=Selection.Address, Type:=8)
If Err.Number <> 0 Then
On Error GoTo errhandler
Err.Raise 999
Else: On Error GoTo errhandler
End If
Set rngLeftHeaders = rngLeftHeaders.Resize(1, rngLeftHeaders.Columns.Count) 'just in case they selected the entire column
rngLeftHeaders.Cells(1, rngLeftHeaders.Columns.Count + 1).Select 'Returns them to the right of the range they just selected
End If

If rngRightHeaders Is Nothing Then
'Identify range containing data and cross-tab headers running across the table
On Error Resume Next
Set rngRightHeaders = Application.InputBox( _
Title:="Select the column HEADERS from the RIGHT of the table that WILL be aggregated", _
prompt:="Select the column HEADERS from the RIGHT of the table that WILL be aggregated", _
Default:=Selection.Address, _
Type:=8)
If Err.Number <> 0 Then
On Error GoTo errhandler
Err.Raise 999
Else: On Error GoTo errhandler
End If
Set rngRightHeaders = rngRightHeaders.Resize(1, rngRightHeaders.Columns.Count) 'just in case they selected the entire column
rngCrossTab.Cells(1, 1).Select 'Returns them to the top left of the source table for convenience
End If

If strCrosstabName = "" Then
'Get the field name for the columns being consolidated e.g. 'Country' or 'Project'. note that reserved SQL words like 'Date' cannot be used
strCrosstabName = Application.InputBox( _
Title:="What name do you want to give the data field being aggregated?", _
prompt:="What name do you want to give the data field being aggregated? e.g. 'Date', 'Country', etc.", _
Default:="Date", _
Type:=2)
If strCrosstabName = "False" Then Err.Raise 999
End If

 

[Tim Hanson]

with more tiring I have

Sub UnPivot()

  fUnPivot_snb 7
End Sub

Sub fUnPivot_snb(q As Long)
Dim varSource As Variant
Dim j As Long
Dim m As Long
Dim n As Long
Dim i As Long
Dim varOutput As Variant
Dim rngCrossTab As Range
Dim rngLeftHeaders As Range
Dim rngRightHeaders As Range

'Identify where the ENTIRE crosstab table is
Set rngCrossTab = Selection.CurrentRegion


'Identify range containing columns of interest running down the table
Set rngLeftHeaders = Range(Cells(1, q), Cells(1, q))

Dim rng As Range
        Dim lastCol As Long

        With Sheets("sheet1")
            lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

Set rngRightHeaders = Range(Cells(1, q + 1), Cells(1, lastCol))

'Get the field name for the columns being consolidated e.g. 'Country' or 'Project'. note that reserved SQL words like 'Date' cannot be used
strCrosstabName = "Question"

 

[BBD]

Hi Tim,

If you upload a file with the pivot, it will be helpful to understand your requirement.

 

[SirJB7]

Hi, Tim Hanson!
The related article at dailydoseofexcel:
http://dailydoseofexcel.com/archives/tag/unpivot/
was written weeks ago by our @jeffreyweir, yes, he's here too, not always but sometimes. Surely if he happens to pass by, he'd give a look at this and be able to help you further.
Regards!

 

[Tim Hanson]

I got it, I added a sort to the end of the un-pivot code which on a larger pivot table take take about 8 times longer to run then the un-pivot.

This is the fastest unpivot sub that I have found and I have tested about 8 of them, this one is only slightly slower.
Attached Files: