Consulting

Results 1 to 3 of 3

Thread: Transpose 1 Column to Multiple Rows/Columns

  1. #1

    Question 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.
    Attached Files Attached Files

  2. #2
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    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

  3. #3
    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 View Post
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •