View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Greg Snidow Greg Snidow is offline
external usenet poster
 
Posts: 153
Default Pivot date, that's all

Greetings all. I have a frequent need to simply pivot a table, and that's
it. I end up using the pivot table wizard, and then trying to copy and paste
the values I need, and it is a time consuming process. All I really need is
to simply pivot it, turning the rows into columns, and visa versa. I made a
simple macro to do the task, but in the interest of learning something new, I
would like to see if anyone else has a better way. Take any table of data,
and highlight the cell between the row header and column header, and run it.
It will produce a pivoted version of the table under the original table. So,
for example, if your table column header is in row 1, and your row labels are
in column A, you would want to select A1, and run the macro. Any ideas on a
better way? Any reason why I should not use this? Thanks in advance, if
anyone is so inclined to give some feedback.

Sub Pivot()

Dim StartCell As Variant
Dim StartCellOld As Variant
Dim r As Integer 'will hold number of rows in the table
Dim rOld As Integer
Dim c As Integer 'will hold number of columns in the table
Dim i As Integer

'Pick a starting point as reference to be used later
StartCell = ActiveCell.Address
StartCellOld = StartCell 'save this to return to the starting point

'Start by counting the rows
r = 0
Range(StartCell).Offset(1, 0).Activate
Do While ActiveCell.Value < ""
ActiveCell.Offset(1, 0).Activate
r = r + 1
Loop

'Then count the columns
Range(StartCell).Activate
Range(StartCell).Offset(0, 1).Activate

c = 0

Do While ActiveCell.Value < ""
ActiveCell.Offset(0, 1).Activate
c = c + 1
Loop

Range(StartCell).Activate

'Populate the new row labels
Range(StartCell).Offset(r + 4, 0).Activate
i = 1
Do While c = 0
ActiveCell.Value = Range(StartCell).Offset(0, i).Value
c = c - 1
i = i + 1
ActiveCell.Offset(1, 0).Activate
Loop
'Then populate the column headers and data
Range(StartCell).Offset(r + 3, 1).Activate
i = 1
rOld = r

Do Until Range(StartCell).Offset(r, 0) = ""
Do Until r = 0
ActiveCell.Value = Range(StartCell).Offset(i, 0).Value
r = r - 1
i = i + 1
ActiveCell.Offset(0, 1).Activate
Loop
StartCell = Range(StartCell).Offset(0, 1).Address
r = rOld
i = 1
ActiveCell.Offset(1, -r).Activate
ActiveCell.Value = Range(StartCell).Offset(i, 0).Value
Loop

Range(StartCellOld).Offset(r + 3, 0).Activate


End Sub