How to copy data and reorganize them in target sheet

[noppph]

Hello Mr.Excel forum,

I'm doing the final exam for my mother, I have created the input sheet as below.
The table contain questions and 4 choices

[TABLE="class: grid, width: 800"]
<tbody>[TR]
[TD="align: center"]Questions[/TD]
[TD="align: center"]Choice 1[/TD]
[TD="align: center"]Choice 2[/TD]
[TD="align: center"]Choice 3[/TD]
[TD="align: center"]Choice 4[/TD]
[/TR]
[TR]
[TD]What is animal ?[/TD]
[TD]Box[/TD]
[TD]Cat[/TD]
[TD]Man[/TD]
[TD]Desk[/TD]
[/TR]
[TR]
[TD]What is the meaning of dance ?[/TD]
[TD]Sleep[/TD]
[TD]Run[/TD]
[TD]Walk[/TD]
[TD]Move rhythmically to music[/TD]
[/TR]
</tbody>[/TABLE]

I want to create a macro to push them to the second sheet with following looks
1. Add the question number
2. 2 rows if all choices contain less than 5 characters
3. 4 rows if any choice contain over 5 characters
4. Add the choices letter "A/B/C/D" to them

it's should look like this.

[TABLE="class: grid, width: 271"]
<tbody>[TR]
[TD="align: right"]1[/TD]
[TD="colspan: 2"]What is animal ?[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A[/TD]
[TD]Box[/TD]
[TD]B[/TD]
[TD]Cat[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]C[/TD]
[TD]Man[/TD]
[TD]D[/TD]
[TD]Desk[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD="colspan: 2"]What is the meaning of dance ?[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A[/TD]
[TD]Sleep[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]B[/TD]
[TD]Run[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]C[/TD]
[TD]Walk[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]D[/TD]
[TD]Move rhythmically to music[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Thank you in advance,
NopppH

 

[MarcelBeug]

This works with me. Note that you didn't explain what to do if the max length = 5 characters. I assumed 2 rows.

Sub CopyDataMB()

Dim srcData() As Variant
Dim i As Long, j As Long
Dim maxLen As Integer
Dim strLen
Dim tgtRow As Long
Dim srcRows As Long

srcRows = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
srcData = Sheet1.Range("A2:E" & srcRows)
tgtRow = 0

For i = 1 To UBound(srcData, 1)
    tgtRow = tgtRow + 1
    Sheet2.Cells(tgtRow, 1) = i
    Sheet2.Cells(tgtRow, 2) = srcData(i, 1)
    tgtRow = tgtRow + 1
    maxLen = 0
    For j = 2 To 5
        strLen = Len(srcData(i, j))
        If strLen > maxLen Then maxLen = strLen
    Next j
    Sheet2.Cells(tgtRow, 2) = "A"
    Sheet2.Cells(tgtRow, 3) = srcData(i, 2)
    If maxLen <= 5 Then
        Sheet2.Cells(tgtRow, 4) = "B"
        Sheet2.Cells(tgtRow, 5) = srcData(i, 3)
        tgtRow = tgtRow + 1
        Sheet2.Cells(tgtRow, 2) = "C"
        Sheet2.Cells(tgtRow, 3) = srcData(i, 4)
        Sheet2.Cells(tgtRow, 4) = "D"
        Sheet2.Cells(tgtRow, 5) = srcData(i, 5)
    Else
        tgtRow = tgtRow + 1
        Sheet2.Cells(tgtRow, 2) = "B"
        Sheet2.Cells(tgtRow, 3) = srcData(i, 3)
        tgtRow = tgtRow + 1
        Sheet2.Cells(tgtRow, 2) = "C"
        Sheet2.Cells(tgtRow, 3) = srcData(i, 4)
        tgtRow = tgtRow + 1
        Sheet2.Cells(tgtRow, 2) = "D"
        Sheet2.Cells(tgtRow, 3) = srcData(i, 5)
    End If

    Next i

End Sub

 

[noppph]

Dear MarcelBeug,

I have try your code and get error at "Sheet2.Cells(tgtRow, 1) = i", the error is "Run time error '424': Object required"
After add the "Option Explicit" (as FAQ said i should add it every time using VBA-Excel), the error is changed to "Compile error: Varialbe not defined"

For the number of rows, I mean that if one of the choice contain over 5 letter, please make it 4 rows as question 2 result.
if all of the choices are <5 letter, please make it 2 row as question 1 result.

Thank you so much for your code and time
NopppH

 

[MarcelBeug]

Please create Sheet2 before you run the code.
I have "Option Explicit" included as well.

If "Cat" would be "Tiger": 2 rows or 4 rows? Still not clear from your explanation. It's neither over 5 letters nor <5 letters.
You might want to change
If maxLen <= 5 Then
to
If maxLen < 5 Then

 

[noppph]

Dear MarcelBeug,

I have added the "Sheet2" before run the code, but it's still give me the same error.

For the idea "Cat" and "Tiger", you are absolutely rigth. i will change the part that you suggested.

Thanks,
NopppH

 

[noppph]

Dear MarcelBeug,

Is that because i'm using the Excel 2013 X64 ?

THanks,

 

[noppph]

Dear MarcelBeug,

I've share my Mom-Exam.xlsm file via my Dropbox account in the link below
https://www.dropbox.com/s/tmcw8o9bat7uyaj/MoM-exam.xlsm?dl=0


Here's how it's look

 

[MarcelBeug]

Possibly you run Excel in a local language and the internal name for Sheet2 is not Sheet2 but something else.
In that case, you should find and replase all "Sheet2" with the internal name of your Sheet2, i.e. the first name appearing in your Project browser, typically at the left hand side of your VB Editor.

Edit: I see in your copy Sheet2 should be Sheet3.

 

[noppph]

Oh, i just check in the VBA(Alt+F11) and it's Sheet3, then i change your code to Shett3 and the magic happen

Do we have chance to fix the name of sheet using this code ?


Thank you alot your VBA code is like a magic.