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.:

Test	Date	Algebra	Geometry	Arithmetic	Test	Date	Spelling
Math	2/2/2019	40	50	60	English	2/5/2019	70

<tbody>
</tbody>

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:

Test	Date	Algebra	Geometry	Arithmetic
Math	2/2/2019	40	50	60
Test	Date	Spelling
English	2/5/2019	70

<tbody>
</tbody>

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:

Test	Date	Algebra	Geometry	Arithmetic	Test	Date	Spelling
Math	2/2/2019	40	50	60	English	2/5/2019	70
Math	4/6/2019	55	65	75

<tbody>
</tbody>

Into an output like this:

Test	Date	Algebra	Geometry	Arithmetic
Math	2/2/2019	40	50	60
Test	Date	Spelling
English	2/5/2019	70
Test	Date	Algebra	Geometry	Arithmetic
Math	4/6/2019	55	65	75

<tbody>
</tbody>

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!