VBA Two dimensional array

Question

I have a question about using VBA to add values to a two dimensional array. The situation is as below: Assume I have a row data.

(The first row is tile, q:quiz, s:semester)

Student name  q1_s1  q2_s2  q3_s1  average_s1 q1_s2  q2_s2  q3_s2 average_s2

 David.          5      6      7       6.       8.     9.    10.   9

The row is stored in sheet1, now in sheet 2(named David), I want to copy these data and list the data like this way.

             average   quiz1.   quiz2.    quiz3


semester_1.    6.        5.       6.        7

semester_2.    9.        8       9      10

Could anyone help we to solve this problem? Should I use a two dimensional array to store them or not?

Thank you very much!!!

Answer 1

With arrays. This reads in the headers, but only outputs the re-arranged data without the new headers. This is written to handle more than 1 person row in case you add data. Note I have corrected what I assume to be a typo where you repeat q2_s2. First instance should be q2_s1.

Option Explicit
Public Sub test()
    Dim arr(), ws As Worksheet, i As Long, j As Long, r As Long, c As Long, outputArr()
    Set ws = ThisWorkbook.Worksheets("Sheet5"): arr = ws.[B1:I2].Value '<=adjust if more rows
    ReDim outputArr(1 To 2 * (UBound(arr, 1) - 1), 1 To UBound(arr, 2) / 2)
    For i = 2 To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2) Step 4
            r = r + 1
            outputArr(r, 1) = arr(i, j + 3)
            outputArr(r, 2) = arr(i, j)
            outputArr(r, 3) = arr(i, j + 1)
            outputArr(r, 4) = arr(i, j + 2)
        Next
    Next
    ws.Cells(5, 1).Resize(UBound(outputArr, 1), UBound(outputArr, 2)) = outputArr
End Sub

---

If students can have different numbers of semesters set your table up to the max possible number of semesters and leave blank those semesters no quizz for a given student then use code:

Option Explicit
Public Sub test()
    Dim arr(), ws As Worksheet, i As Long, j As Long, r As Long, c As Long, outputArr(), numberOfColumns As Long
    Set ws = ThisWorkbook.Worksheets("Sheet5"): arr = ws.[B1:M3].Value
    numberOfColumns = UBound(arr, 2) / 4
    ReDim outputArr(1 To numberOfColumns * (UBound(arr, 1) - 1), 1 To UBound(arr, 2) / numberOfColumns)
    For i = 2 To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2) Step 4
            r = r + 1
            outputArr(r, 1) = arr(i, j + 3)
            outputArr(r, 2) = arr(i, j)
            outputArr(r, 3) = arr(i, j + 1)
            outputArr(r, 4) = arr(i, j + 2)
        Next
    Next
    ws.Cells(Ubound(arr,1) + 5 , 1).Resize(UBound(outputArr, 1), UBound(outputArr, 2)) = outputArr
End Sub

Example layout where maximum semesters is 3 and 1 student only completed 2 semesters:

Answer 2

if i understood your question you don't need a two dimensional array but to copy the data from sheet1 into sheet2.

this is an example:

Sub test()
'copy data from sheet1 into sheet2(named David)
'in this code i know where are the data into sheet1 and where i want to put into sheet2(named David).

'execute macro into sheet1
Dim studentName As String

studentName = Cells(2, 1) 'in this example is David

With Sheets(studentName) 'call sheet David

    'semestre1
    .Cells(2, 3) = Cells(2, 2) 'put into cells(2,3)sheet David the data of the sheet1 is q1_s1 in semestre1 quiz1
    .Cells(2, 4) = Cells(2, 3) 'q2_s1 into semestre1 quiz2
    .Cells(2, 5) = Cells(2, 4) 'q3_s1 into semestre1 quiz3
    .Cells(2, 2) = Cells(2, 5) 'average semestre1

    'semestre2
    .Cells(3, 3) = Cells(2, 6) 'put into cells(2,3)sheet David the data of the sheet1 is q2_s1 in semestre2 quiz1
    .Cells(3, 4) = Cells(2, 7) 'q2_s2 into semestre2 quiz2
    .Cells(3, 5) = Cells(2, 8) 'q3_s2 into semestre2 quiz3
    .Cells(3, 2) = Cells(2, 9) 'average semestre2

End With
End Sub

sheet1 where are the data

sheet2(David) where are put the informations

it is tested and works. Hope this help you