Unpivot_20151204.bas

Attribute VB_Name = "basUnpivot_20151204"


Sub unPivot_20()
Dim oTarget As Range
Dim oSource As Range
Dim oCell As Range
' original http://superuser.com/a/583083/529888
' posted by http://superuser.com/users/217174/tjmelrose
' will unpivot a table in Excel 2010

'name the data only as the source range
'name a single cell on same worksheet as the target range
'converts all rows above and all columns left of 'data' range

Set oSource = Names("Source").RefersToRange
Set oTarget = Names("Target").RefersToRange

cRow = oSource.Row - 1
cCol = oSource.Column - 1

For Each oCell In oSource
    If oCell.Value <> "" Then
        oTarget.Activate
      ' get the column headers
      For i = 1 To cRow
        oTarget.Value = oCell.Offset(-(oCell.Row - oSource.Row + i), 0).Value
        Set oTarget = oTarget.Offset(0, 1)
      Next
      ' get the row headers
      For i = 1 To cCol
         oTarget.Value = oCell.Offset(0, _
           -(oCell.Column - oSource.Column + i)).Value
           Set oTarget = oTarget.Offset(0, 1)
      Next
      ' get the value
        oTarget.Value = oCell.Value
      ' move the target pointer to the next row
        Set oTarget = oTarget.Offset(1, -(cRow + cCol))
    End If
Next
Beep
End Sub