View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Advanced transpose (columns to rows) function?

You could use a macro:

Option Explicit
Sub testme()

Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim iCol As Long
Dim oRow As Long
Dim Res As Variant

Set CurWks = Worksheets("Sheet1")
Set NewWks = Worksheets.Add

With CurWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

.Range("B1", .Cells(LastRow, "B")).AdvancedFilter _
action:=xlFilterCopy, unique:=True, _
copytorange:=NewWks.Range("a1")
End With

With NewWks
With .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
.Cells.Sort key1:=.Columns(1), order1:=xlAscending, _
header:=xlNo
.Copy
End With
.Range("b1").PasteSpecial Transpose:=True
.Range("a1").EntireColumn.Clear
.Range("A1").Value = CurWks.Range("A1").Value
End With

With CurWks
oRow = 1
For iRow = FirstRow To LastRow
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A") Then
'same group, keep the same output row
Else
oRow = oRow + 1
NewWks.Cells(oRow, "A").Value = .Cells(iRow, "A").Value
End If
Res = Application.Match(.Cells(iRow, "B").Value, NewWks.Rows(1), 0)
If IsError(Res) Then
'this shouldn't happen
MsgBox "Error on: " & iRow
Exit Sub
End If
NewWks.Cells(oRow, Res).Value = "'" & .Cells(iRow, "C").Value
Next iRow
End With

NewWks.UsedRange.Columns.AutoFit

End Sub

If you're new to macros:

Debra Dalgleish has some notes how to implement macros he
http://www.contextures.com/xlvba01.html

David McRitchie has an intro to macros:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Ron de Bruin's intro to macros:
http://www.rondebruin.nl/code.htm

(General, Regular and Standard modules all describe the same thing.)

mcmilja wrote:

Hello,

I am in need of a way to transpose some data from columns to rows

FROM
CIRCUIT_PATH_ID PORT_NUM PORT
EAGLEVILLE 470 1-1 PORT1 T1-5/0/0:09:01
EAGLEVILLE 470 1-1 PORT2 0961-01
EAGLEVILLE 470 1-1 PORT3 0738-18
EAGLEVILLE 470 1-1 PORT4 01-1

TO:
CIRCUIT_PATH_ID PORT1 PORT2 PORT3 PORT4
EAGLEVILLE 470 1-1 T1-5/0/0:09:01 0961-01 0738-18 01-1


--

Dave Peterson