Convert rows into stacked columns in excel

Question

I have a data set in the following form: (each comma denotes a separate column in excel)

Name1, Number11, Number12, Number13
Name2, Number21
Name3, Number31, Number32

A particular name has different number attributes associated with it which are present in adjoining columns in the format shown above. There is no fixed number of attributes associated with a particular name, like Name1 has 3, Name2 has 1 and so on. I want the output in two columns as

Name1, Number11
Name1, Number12
Name1, Number13
Name2, Number21
Name3, Number31
Name3, Number32

So far, through help on the internet, I have arrived at a point, which I think is closer to the solution, but I don't believe that to be optimal. First I found out which name has the maximum number of attributes and then I filled in the empty cells in all other names with a special character ($) so that all the names have same number of columns filled to the right. The data looked like this after the operation:

Name1, Number11, Number12, Number13
Name2, Number21, $, $
Name3, Number31, Number32, $

Then I used the following code: (got it from the internet)

Sub ConvertRangeToColumn()    
    Dim Range1 As Range, Range2 As Range, Rng As Range    
    Dim rowIndex As Integer    
    Set Range1 = Application.Selection    
    Set Range1 = Application.InputBox("Source Ranges:", Range1.Address, Type:=8)    
    Set Range2 = Application.InputBox("Convert to (single cell):", xTitleId, Type:=8)
    rowIndex = 0
    Application.ScreenUpdating = False    
    For Each Rng In Range1.Rows    
        Rng.Copy    
        Range2.Offset(rowIndex, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        rowIndex = rowIndex + Rng.Columns.Count    
    Next    
    Application.CutCopyMode = False    
    Application.ScreenUpdating = True    
End Sub

I got all the values in a single column. Then I filtered for the $ values and removed them. So now the data looks like:

Name1
Number11
Number12
Number13
Name2
Number21
Name3
Number31
Number32

I have not been able to get beyond this and hence this post. Can you help getting from here to the final output, or using a better methodology altogether, preferably one in which I don't have to go around filling the empty cells? Thanks!

Answer 1

Sub getOut()

    Dim rngIn   As Range
    Dim rngOut  As Range
    Dim intRowC As Long
    Dim intColC As Long
    Dim strVal1 As String
    Dim strVal2 As String

    Set rngOut = Sheet1.Range("K1") '<<---Data
    Set rngIn = Sheet1.Range("A1").CurrentRegion '<<----Output
    For intRowC = 1 To rngIn.Rows.Count
        For intColC = 1 To rngIn.Rows(intRowC).Cells.Count
            strVal1 = rngIn.Cells(intRowC, 1).Value
            strVal2 = rngIn.Cells(intRowC, intColC).Value
            If intColC > 1 Then
                If strVal2 = vbNullString Then Exit For
                rngOut.Value = strVal1
                rngOut.Offset(, 1).Value = strVal2
                Set rngOut = rngOut.Offset(1)
            End If
        Next intColC
    Next intRowC

ClearMemory:
    Set rngIn = Nothing
    Set rngOut = Nothing
    intRowC = Empty
    intColC = Empty
    strVal1 = vbNullString
    strVal2 = vbNullString
End Sub

Hope this will resolve your concern... :)

Answer 2

If we start with this in Sheet3:

and run this macro:

Sub ReOrganize()
    Dim s1 As Worksheet, s2 As Worksheet, i As Long, j As Long, K As Long
    Dim v1 As Variant, v2 As Variant, N1 As Long, N2 As Long
    Set s1 = Sheets("Sheet3")
    Set s2 = Sheets("Sheet4")
    K = 1
    N1 = s1.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 1 To N1
        v1 = s1.Cells(i, 1).Value
        N2 = s1.Cells(i, Columns.Count).End(xlToLeft).Column
        For j = 2 To N2
            s2.Cells(K, 1).Value = v1
            s2.Cells(K, 2).Value = s1.Cells(i, j)
            K = K + 1
        Next j
    Next i
End Sub

We will end up with this in Sheet4