Transpose 1 Column to Multiple Rows/Columns

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.

Code:

---

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

---

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

Quote:

---

Originally Posted by mana

Code:

---

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

---

---