excel macro: for each cell with a value in a row, insert a row below with that value

Question

I have a worksheet with ~700 rows, and 7 columns. I need each row to have just one entry. I.e. if row 1 has cell values in column A,B and C, then two new rows should be created so row 1 has one value in column A, row 2 has one value in column B and row 3 has one value in column C.

I have spent a couple hours on this (sadly) but I'm so bad, I'm not getting anywhere:

Sub TThis()
Dim rng As Range
Dim row As Range
Dim cell As Range

'just testing with a basic range
Set rng = Range("A1:C2") 

For Each row In rng.Rows
  For Each cell In row.Cells
If cell.Value <> "" Then
        'write to adjacent cell
        Set nextcell = cell.Offset(1, 0)
        nextcell.Value = cell.Value
        nextcell.EntireRow.Insert
    End If
Next cell
Next row
End Sub

My issue is that this code deletes the row beneath it (which is not suppose to happen) and it inserts two rows instead of one.

Thanks a ton!

The easiest way to do this would be to transfer A1 to D1, B1 to D2, C1 to D3 and so on. Then, when finished, you delete the first three columns. Voilà, you have your row in range A. Let me write a quick program for you demonstrating that. — Sifu
awesome! but, i forgot to mention something rather important: each row has an ID 9referenced in G. when you transfer the value of A1 to D1 etc, is it possible to give the new row the same ID in G? — user3776607
Nevermind on my little quick program, Alex P was faster and has a better answer than mine! — Sifu

Alex P Alex P · Accepted Answer · 2014-07-15T16:05:42

I'd read your data into an array, delete the data on the worksheet, and then write back to the worksheet in a single column (whilst checking for blanks)

Example:

Sub OneColumnData()
    Dim rng As Range, ids As Range, arr() As Variant, rw As Integer, col As Integer, counter As Integer

    Set rng = Range("A1:C5")
    Set ID = Range("G1:G5")

    arr = rng.Value
    counter = 1

    rng.ClearContents

    For rw = 1 To UBound(arr, 1)
        For col = 1 To UBound(arr, 2)
            If arr(rw, col) <> vbNullString Then
                Range("A" & counter) = arr(rw, col)
                Range("B" & counter) = ID(rw)
                counter = counter + 1
            End If
        Next col
    Next rw
End Sub

excel macro: for each cell with a value in a row, insert a row below with that value

1 Answers