Combining 5 columns into one column for variable data in Excel-CodePudding

I need to restructure my data so that it goes from 5 columns to 1 column, while preserving the relative positions. The example is generic but the real data will have different stems and responses for each row.

For example, say I have the data below:

I want to end up with data that looks like the image below:

The real data sets will always have 5 columns, but each stem and response will be different

I tried VBA and macros, but am not well versed in either of those. I am expecting to go from 5 columns(a stem and 4 responses) to 1 columns that contains a list of a stem followed by it's responses, then the next stem and its responses,...etc.

I have looked into some VBA and macros but haven't found something that works or haven't been applying them properly. Does anyone know a macro or VBA commands to get this to work?

Thanks for any help you can give me!

CodePudding user response：

Sub MyTransposer()
    
    Dim Source As Range
    
    ' To use Activecell, select the top left corner
    ' of the starting cell and comment the next line.
    Range("A1").Select
      
    Do Until ActiveCell = "" ' Must be a contiguous block
    
        Set Source = Range(ActiveCell.Offset(0, 1), Selection.End(xlToRight))
            
        ' Insert a row for each column
        For i = 1 To Source.Columns.Count
            ActiveCell.Offset(1, 0).EntireRow.Insert
        Next
        
        ' Copy and paste/transpose
        Source.Copy
        ActiveCell.Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        
        ' Line up on next row
        ActiveCell.Offset(Source.Columns.Count, 0).Select
    
    Loop
    
End Sub

CodePudding user response：

Transpose Rows To Single Column

Sub TransposeRowsToSingleColumn()

    Const EmptyRowsCount As Long = 0

    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    ' Reference the source range.
    Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion
    
    ' Use the function to return the transposed data in an array.
    Dim Data() As Variant: Data = GetRowsInSingleColumn(srg, EmptyRowsCount)
    
    ' Reference the destination range.
    Dim dfCell As Range: Set dfCell = ws.Range("E1")
    Dim drg As Range: Set drg = dfCell.Resize(UBound(Data, 1))
    
    ' Write the values from the array to the destination range.
    drg.Value = Data
    
End Sub

Function GetRowsInSingleColumn( _
    ByVal SourceRange As Range, _
    Optional ByVal EmptyRowsCount As Long = 0) _
As Variant

    Dim sData() As Variant, srCount As Long, scCount As Long

    With SourceRange
        srCount = .Rows.Count
        scCount = .Columns.Count
        If srCount * scCount = 1 Then
            ReDim sData(1 To 1, 1 To 1): sData(1, 1) = .Value
        Else
            sData = .Value
        End If
    End With
    
    Dim drCount As Long
    drCount = srCount * scCount   (srCount - 1) * EmptyRowsCount
    
    Dim dData() As Variant: ReDim dData(1 To drCount, 1 To 1)
    
    Dim sr As Long, sc As Long, dr As Long
    
    For sr = 1 To srCount
        For sc = 1 To scCount
            dr = dr   1
            dData(dr, 1) = sData(sr, sc)
        Next sc
        dr = dr   EmptyRowsCount
    Next sr
    
    GetRowsInSingleColumn = dData

End Function