Reorganize data using VBA

[Jimbob2000]

I have a database that produces reports about tests taken by students all on one row. The data always includes a test name, test date, and one or more scores. E.g.:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Test[/TD]
[TD]Date[/TD]
[TD]Algebra[/TD]
[TD]Geometry[/TD]
[TD]Arithmetic[/TD]
[TD]Test[/TD]
[TD]Date[/TD]
[TD]Spelling[/TD]
[/TR]
[TR]
[TD]Math[/TD]
[TD]2/2/2019[/TD]
[TD]40[/TD]
[TD]50[/TD]
[TD]60[/TD]
[TD]English[/TD]
[TD]2/5/2019[/TD]
[TD]70[/TD]
[/TR]
</tbody>[/TABLE]

Sometimes there five or six tests, each with five or six scores.

We run these reports all the time and it would be really convenient to fix the data using a macro rather than by hand. I'm looking for a way to use VBA to convert this data into a table that looks like this:


[TABLE="width: 500"]
<tbody>[TR]
[TD]Test[/TD]
[TD]Date[/TD]
[TD]Algebra[/TD]
[TD]Geometry[/TD]
[TD]Arithmetic[/TD]
[/TR]
[TR]
[TD]Math[/TD]
[TD]2/2/2019[/TD]
[TD]40[/TD]
[TD]50[/TD]
[TD]60[/TD]
[/TR]
[TR]
[TD]Test[/TD]
[TD]Date[/TD]
[TD]Spelling[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]English[/TD]
[TD]2/5/2019[/TD]
[TD]70[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

It's tricky because the number of scores for each test can vary. Any help you can provide would be very greatly appreciated!

 

[offthelip]

try this code:

Sub test()
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
inarr = Range(Cells(1, 1), Cells(2, lastcol))
indi = 4
coli = 2
' put the first "test " in
Cells(indi, 1) = inarr(1, 1)
Cells(indi + 1, 1) = inarr(2, 1)


For i = 2 To lastcol
  If inarr(1, i) = "Test" Then
   indi = indi + 2
   coli = 1
  End If
  Cells(indi, coli) = inarr(1, i)
  Cells(indi + 1, coli) = inarr(2, i)
  coli = coli + 1
Next i


End Sub

 

[Jimbob2000]

This is works perfectly! Thank you!

As a follow up question: Sometimes, students retake sets of tests and the database creates a new row for the retakes. Some students have up to ten rows of data, each with multiple tests and multiple scores on each test. Is there any way to modify the code you created to cope with an undefined number of rows?

Essentially turning something like this:


[TABLE="width: 500"]
<tbody>[TR]
[TD]Test[/TD]
[TD]Date[/TD]
[TD]Algebra[/TD]
[TD]Geometry[/TD]
[TD]Arithmetic[/TD]
[TD]Test[/TD]
[TD]Date[/TD]
[TD]Spelling[/TD]
[/TR]
[TR]
[TD]Math[/TD]
[TD]2/2/2019[/TD]
[TD]40[/TD]
[TD]50[/TD]
[TD]60[/TD]
[TD]English[/TD]
[TD]2/5/2019[/TD]
[TD]70[/TD]
[/TR]
[TR]
[TD]Math[/TD]
[TD]4/6/2019[/TD]
[TD]55[/TD]
[TD]65[/TD]
[TD]75[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Into an output like this:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Test[/TD]
[TD]Date[/TD]
[TD]Algebra[/TD]
[TD]Geometry[/TD]
[TD]Arithmetic[/TD]
[/TR]
[TR]
[TD]Math[/TD]
[TD]2/2/2019[/TD]
[TD]40[/TD]
[TD]50[/TD]
[TD]60[/TD]
[/TR]
[TR]
[TD]Test[/TD]
[TD]Date[/TD]
[TD]Spelling[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]English[/TD]
[TD]2/5/2019[/TD]
[TD]70[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Test[/TD]
[TD]Date[/TD]
[TD]Algebra[/TD]
[TD]Geometry[/TD]
[TD]Arithmetic[/TD]
[/TR]
[TR]
[TD]Math[/TD]
[TD]4/6/2019[/TD]
[TD]55[/TD]
[TD]65[/TD]
[TD]75[/TD]
[/TR]
</tbody>[/TABLE]


I really appreciate your help with this!

James

 

[offthelip]

try this code:

Sub test()
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
inarr = Range(Cells(1, 1), Cells(10, lastcol))
indi = 12
nextindi = indi
coli = 1


For i = 1 To lastcol
  If inarr(1, i) = "Test" Then
   indi = nextindi
   coli = 1
  End If


    For k = 1 To 10
    If inarr(k, i) = "" Then
    nextindi = k + indi - 1
    Exit For
    Else
    
    Cells(indi + k, coli) = inarr(k, i)
    End If
    Next k
    coli = coli + 1
Next i




End Sub

 

[Jimbob2000]

Thanks again! This worked perfectly!