Transpose 1 Column to Multiple Rows/Columns

[newbee2xel]

I am in need of a VB or Macro that will allow me to transpose a list of 62000 in column A to several rows/columns.

The criteria would be that the last cell of each row would have "Add/edit to groups" or "Add to groups" and then the next row would start.

The Close Matches tab is where the original data is and the transpose tab is where the sample finished data is.

[mana]

Option Explicit


Sub test()
Dim dic As Object
Dim v
Dim k As Long, n As Long
Dim s As String

Set dic = CreateObject("scripting.dictionary")

v = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value

n = 1
For k = 1 To UBound(v)
s = v(k, 1)
If Len(s) > 0 Then
dic(n) = dic(n) & vbTab & s
If s = "Add/edit groups" Then n = n + 1
End If
Next

With Range("B1").Resize(n)
.Value = Application.Transpose(dic.items)
.TextToColumns DataType:=xlDelimited, Tab:=True, Other:=False
End With


End Sub

[newbee2xel]

Will this work with an added "or" If s = "Add/edit groups or Add to groups" Then n = n + 1





Option Explicit


Sub test()
Dim dic As Object
Dim v
Dim k As Long, n As Long
Dim s As String

Set dic = CreateObject("scripting.dictionary")

v = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value

n = 1
For k = 1 To UBound(v)
s = v(k, 1)
If Len(s) > 0 Then
dic(n) = dic(n) & vbTab & s
If s = "Add/edit groups" Then n = n + 1
End If
Next

With Range("B1").Resize(n)
.Value = Application.Transpose(dic.items)
.TextToColumns DataType:=xlDelimited, Tab:=True, Other:=False
End With


End Sub