VBA that splits a row into several returns extra data

Question

I'm new to VBA a need some help with the code.

I have a large spreadsheet with several thousands of rows with a unique_ID per row and from 7 to 65 answers to the questions. I need to split this rows by id, so that each row has ID, Question number, and Numeric value (Question answer).

The original data looks like this:

Data example

I found a VBA code that helped me to split rows on this page: Split a row into several, with an identifier

And this is the code I was using:

Sub NewLayout()
For i = 2 To Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    For j = 0 To Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
        If Cells(i, 13 + j) <> vbNullString Then
            intCount = intCount + 1
            Cells(i, 1).Copy Destination:=Cells(intCount, 30)
            Cells(i, 2 + j).Copy Destination:=Cells(intCount, 31)
            Cells(i, 13 + j).Copy Destination:=Cells(intCount, 32)
        End If
    Next j
Next i
End Sub

The code seems to work, but I have issues with the output: It returns some extra data, and I don't know where is the mistake in the code and how to get rid of it.

The example of the output is attached.

Output example

Any help is greatly appreciated!

Answer 1

Try it as,

Sub NewLayout()
    with worksheets("sheet1")
        For i = 2 To .Cells(.rows.count, "A").end(xlup).Row
            For j = 0 To .Cells(i, 29).end(xltoleft).Column
                .cells(.rows.count, "AD").end(xlup).offset(1,0) = .cells(i, "A").value
                .cells(.rows.count, "AD").end(xlup).offset(0,1) = .cells(1, j).value
                .cells(.rows.count, "AD").end(xlup).offset(1,0) = .cells(i, j).value
            Next j
        Next i
    end with
End Sub

Your terminating j was being reevaluated within the nested For ... Next while you were writing values into columns AD:AF. You might consider writing to another worksheet or below your existing data instead of to the right.