Advanced transpose (columns to rows) function?

[mcmilja]

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]

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 here:
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.)

 

[Dave Peterson]

This line:
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A") Then
'same group, keep the same output row
should be:
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
'same group, keep the same output row

(I don't like to rely on the default property.)

 

[ShaneDevenshire]

Hi,

1. If you only want to do it once then if your data is in cells A1:E5
enter the following formula in cell H2
=A2
copy this to the right 3 columns, to column J.
Next select the range K2:N2 and type but do not enter the following formula:
=TRANSPOSE(E2:E5)
Now press Shift+Ctrl+Enter

2. If your data continues down in exactly the same way for many rows then
enter the formulas as above
Select the range H2:N5 and drag the fill handle down as far as you need.

Your results will be spaces three rows apart but that is no problem. If you
want to compact them:
1. Click the column letters H:N and
2. press F5, and choose Special, Blanks and press OK.
3. Choose Edit, Delete, Shift cells up.

Finally, you can convert the formulas to values by copying the range of
formulas and choosing Edit, Paste Special, Paste values.