Transpose Range on Key

[Lucky 13]

Hi all, can some please help me. My VBA skills are very limited but I understand the basic's. I have search the forums and could not find anything related to my query.

I want to transpose this
SPEED | 1500 REVOLUTIONS PER MINUTE
SPEED | 1640/7.63 REVOLUTIONS PER MINUTE
SPEED | 172 REVOLUTIONS PER MINUTE
SPEED | 960 REVOLUTIONS PER MINUTE
RATIO | 20.1
RATIO | 21:35.1
COMMERCIAL SIZE | 5
COMMERCIAL SIZE | 6

Into this;
column A
SPEED
1500 REVOLUTIONS PER MINUTE
1640/7.63 REVOLUTIONS PER MINUTE
172 REVOLUTIONS PER MINUTE
960 REVOLUTIONS PER MINUTE

Column B
RATIO
20.1
21:35.1

Column C
COMMERCIAL SIZE
5
6

Any help will be greatly appreciated

[Bob Phillips]

Sub MoveData()
Dim lastrow As Long
Dim lastcol As Long
Dim startat As Long
Dim prev As String
Dim i As Long

Application.ScreenUpdating = False

With ActiveSheet

lastrow = .UsedRange.Rows.Count
lastcol = .UsedRange.Columns.Count
For i = lastrow To 2 Step -1

If .Cells(i, "A").Value <> prev Then

prev = .Cells(i, "A").Value
startat = i
Do While prev = .Cells(startat, "A").Value And startat > 1

startat = startat - 1
Loop

.Columns(lastcol + 1).Insert
.Cells(1, lastcol + 1).Value = prev
.Cells(startat + 1, "B").Resize(i - startat).Copy .Cells(2, lastcol + 1)
End If

i = startat + 1
Next i

.Columns("A:B").Delete
End With

Application.ScreenUpdating = True
End Sub

[Lucky 13]

Perfect! thank you so much!

[BrianMH]

Sub DataRearrange()
Dim r As Range
Dim c As Range
Set r = Sheets("Sheet1").Range("A1:A8")
Dim vHeader As Variant
Dim vValue As Variant
Dim aSplit As Variant
Dim i As Integer


Dim dHeader As Dictionary
Dim dValue As Dictionary
Set dHeader = New Dictionary
Set dValue = New Dictionary


For Each c In r.Cells
aSplit = Split(c.Value, "|")
vHeader = Trim(aSplit(0))
vValue = Trim(aSplit(1))
If dHeader.Exists(vHeader) Then
Set dValue = dHeader(vHeader)
dValue.Add vValue, vValue
Else
Set dValue = New Dictionary
dValue.Add vValue, vValue
dHeader.Add vHeader, dValue
End If
Next c

r.Clear
i = 1


For Each vHeader In dHeader.Keys
Set c = r.Cells(1, i)
c.Value = vHeader
Set c = c.Offset(1)
Set dValue = dHeader(vHeader)
For Each vValue In dValue.Keys
c.Value = dValue(vValue)
Set c = c.Offset(1)
Next
i = i + 1
c = r.Cells(1, i)
Next





End Sub

This is how I did it. It separates into separate columns your data.

[BrianMH]

XLD just to clarify your sub does basically the same thing as copying and pasting special with the transpose box right?

[Bob Phillips]

Not really, it just determines the groups and then copies those groups into a new column. When I read the explanation in your post, I thought that we were approaching it the same way.

[BrianMH]

For some reason when I run your macro it just works like the transpose paste function. Was just curious why. Looking at the way others do things is how I learn new methods :)