Copy rows with different lengths into two columns

Question

I am trying to convert data from rows with different lengths into two columns.

The value of the first column remains equal to first cell of the row and is copied down to equal amount of rows as there are cells in the source row.

The second column is the rest of the cells of the source row copied and transposed to the second column.

Below is an example of what I wish to do.
Row length is max 18 cells and amount of rows may vary but is calculated in hundreds.

I found code here that is close to what I need.
Link: Copy Rows into columns using VBA

How do I change the code to a working solution?

Data format

Desired outcome

Start point

End result

score 0 · Answer 1 · edited May 03 '22 at 17:19

0

It's brute force and ugly but quickest way I could write it.

Good for new users of VBA as it's the instructions you would give to a person to perform the task.

It would also be easy to adapt it to include your variable formatting.

Sub RearrangeNumbers()
Dim RowCnt As Integer       'rows of data to deal with
Dim ItemCnt As Integer      'number of number items in row
Dim RowActive As Integer    'Active Row
Dim tempRNG As Range        'range storage
Dim I As Integer            'Integer

    'Count Data Rows
RowCnt = Range("A" & Rows.Count).End(xlUp).Row

    'Set starting row
RowActive = 2

    'Cycle.
For I = 2 To RowCnt
    
    'Count items
    ItemCnt = Application.WorksheetFunction.CountA(Rows(RowActive)) - 1
    
    'Make sure there are more than 1 item(s)
    If ItemCnt > 1 Then
        
        'Make Space
        Rows(RowActive + 1 & ":" & RowActive + ItemCnt - 1).Insert Shift:=xlDown
        
        'Store number items as range
        Set tempRNG = Range(Cells(RowActive, 2), Cells(RowActive, ItemCnt + 1))
        
        'Paste that transposed range to sheet
        Range(Cells(RowActive, 2), Cells(RowActive + ItemCnt - 1, 2)) = Application.WorksheetFunction.Transpose(tempRNG)
        
        'Clear old data
        Range(Cells(RowActive, 3), Cells(RowActive, ItemCnt + 1)).ClearContents
        
        'Copy down first number
        Range(Cells(RowActive, 1), Cells(RowActive + ItemCnt - 1, 1)).FillDown
    End If
    
    'Relocate next data set
    RowActive = RowActive + ItemCnt
Next I

End Sub

Before:

After:

edited May 03 '22 at 17:19

Community

1
1

answered Feb 03 '22 at 03:28

Cameron Critchlow

1,814
1
4
14

Thanks this did the work perfectly! It's easy to remove the empty cells in the column 2, so I don't have the need to adapt the code to variable row. – Ade Feb 03 '22 at 07:17
The code didn't leave gaps in my test run; could you post a screenshot? I'm curious to see where it went wrong. – Cameron Critchlow Feb 03 '22 at 18:32
I added start point and end result to your for you to the question. – Ade Feb 07 '22 at 20:12
Ah, I'll bet your sheet has cells with spaces or some other such character. – Cameron Critchlow Feb 08 '22 at 18:53
If you change the WorksheetFunction.CountA(Rows(RowActive)) to WorksheetFunction.CountIf(Rows(RowActive),">0") – Cameron Critchlow Feb 08 '22 at 19:04
It's numbers but has 0 as the first i.e. text format. – Ade Feb 10 '22 at 19:30
did you try the changed formula? – Cameron Critchlow Feb 12 '22 at 07:31

Copy rows with different lengths into two columns

1 Answers1