Programming to create a report from raw data

[Jcraig713]

Hello. I have data in my excel file which contains many many rows; 9900 to
be exact, of student names and room locations in a building. The file (raw
data) looks like this in excel:

ColA Col B Col C Col D Col E
Name Grade Period Room Student ID#
Doe, John 12th 1 101 199999999
Doe, John 12th 2 102 199999999
Doe, John 12th 3 103 199999999
Doe, John 12th 4 104 199999999
Doe, John 12th 5 105 199999999
Doe, John 12th 6 106 199999999
Doe, Jane 11th 1 201 299999999
Doe, Jane 11th 2 202 299999999

etc........

This data is exported from our software system database like that through
period 7. What I would like for mail merge purposes or better yet, in excel
to create a report, is to get each student as listed in multiple rows, on one
row (record) so the mail merge knows where to put the info. What I would
like to do create programming that reads the raw data and reformat the file
to look like:

Name Grade Per 1 Rm Per 2 RM Per 3 RM
Doe, John 12 101 102 103
Doe, Jane 11 201 202 203 etc....

Is there a way to do this reformatting in excel without having to do this
one record at a time? Your assistance would be greatly appreciated.

 

[Barb Reinhardt]

The quickest way to do this would be with a pivot table. It's quick and
dirty and I think gets you what you want. If you do want to program this,
come back.

Select the range to be used for the pivot table (including headers)

Data -> Pivot Table
Next -> Next -> Finish
Drop Name in ROW FIeld
Drop Period in Column Field
Drop Room in Data Items.
Double Click on "Count of Room" and change to SUM

 

[Dave Peterson]

This uses the student id as the key value. (I think that there's less chance of
duplication compared to using the name).

Option Explicit
Sub testme()

Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim oRow As Long
Dim res As Variant

Set CurWks = Worksheets("Sheet1")
Set NewWks = Worksheets.Add

With CurWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row

'sort original range by Id, name, period
With .Range("a1:E" & LastRow)
.Sort key1:=.Columns(5), order1:=xlAscending, _
key2:=.Columns(1), order2:=xlAscending, _
key3:=.Columns(3), order3:=xlAscending, _
header:=xlYes
End With

'Get a list of unique class periods
.Range("C1:C" & LastRow).AdvancedFilter _
action:=xlFilterCopy, unique:=True, copytorange:=NewWks.Range("A1")
End With

With NewWks
With .Range("a:a")
.Sort key1:=.Columns(1), order1:=xlAscending, header:=xlYes
End With

.Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Copy
.Range("D1").PasteSpecial Transpose:=True
.Range("a:c").Clear
End With

With CurWks
oRow = 1
For iRow = FirstRow To LastRow
If .Cells(iRow, "E").Value <> .Cells(iRow - 1, "E").Value Then
'different student
oRow = oRow + 1
NewWks.Cells(oRow, "A").Value = .Cells(iRow, "A").Value
NewWks.Cells(oRow, "B").Value = .Cells(iRow, "B").Value
NewWks.Cells(oRow, "C").Value = .Cells(iRow, "E").Value
Else
'same person as before.
'don't add "headers"
End If
res = Application.Match(.Cells(iRow, "C").Value, NewWks.Rows(1), 0)
If IsError(res) Then
'shouldn't happen!
MsgBox "Error with row: " & iRow
Else
NewWks.Cells(oRow, res).Value = .Cells(iRow, "d").Value
End If
Next iRow
End With

NewWks.UsedRange.Columns.AutoFit

End Sub

 

[Jcraig713]

Hello Barb.

Thanks for your help. I know it is probably far more complicated to program
something. But I would like to try. This document will be sent out within
the building and district so it is important for the report to look pretty
and easy to read for people. Can this be done with Excel?

 

[Jcraig713]

Thanks Dave,
I understand where to put this code, how would I use it with my raw data?
Would you suggest I create a file with this code then cut and paste my raw
data into it?

 

[Dave Peterson]

You can put the code into a general module of the workbook with the data.

Then change this line:
Set CurWks = Worksheets("Sheet1")
to point at the worksheet with the data.

Save the workbook (just in case something bad happens).

Then run the macro. Your original data will get sorted, but that's the only
thing that will be changed on that sheet.

The output is placed onto a new sheet that's added to your workbook.

If you don't want your data to get sorted, then copy the data to a new sheet,
point the macro to that sheet and run the code.

You'll end up with 3 sheets. The original; the sorted version of the original;
and the output.

 

[Jcraig713]

Dave you are a Master! I ran the code by entering the module you suggested.
The only thing is I my system will not give me the student name in an output
of xxx,xxx. I have to put the last and first name in seperate columns
thereby extending the the column out to F (see below). I tried to see in
your code where I could amend it to account for the dataset change but in the
end, I do not have the expertise. Can you amend your code to accomplish the
original intent now accounting for the additional data column?

ColA Col B Col C Col D Col E ColF
Lname Fname Grade Period Room Student ID#
Doe John 12th 1 101 199999999
Doe John 12th 2 102 199999999
Doe John 12th 3 103 199999999
Doe John 12th 4 104 199999999
Doe John 12th 5 105 199999999
Doe John 12th 6 106 199999999
Doe Jane 11th 1 201 299999999
Doe Jane 11th 2 202 299999999

 

[Dave Peterson]

Here you go:

Option Explicit
Sub testme()

Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim oRow As Long
Dim res As Variant

Set CurWks = Worksheets("Sheet1")
Set NewWks = Worksheets.Add

With CurWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row

'sort original range by Id, name, period
With .Range("a1:f" & LastRow)
.Sort key1:=.Columns(6), order1:=xlAscending, _
key2:=.Columns(4), order2:=xlAscending,
header:=xlYes
End With

'Get a list of unique class periods
.Range("d1:d" & LastRow).AdvancedFilter _
action:=xlFilterCopy, unique:=True, copytorange:=NewWks.Range("A1")
End With

With NewWks
With .Range("a:a")
.Sort key1:=.Columns(1), order1:=xlAscending, header:=xlYes
End With

.Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Copy
.Range("e1").PasteSpecial Transpose:=True
.Range("a:c").Clear
End With

With CurWks
oRow = 1
For iRow = FirstRow To LastRow
If .Cells(iRow, "f").Value <> .Cells(iRow - 1, "f").Value Then
'different student
oRow = oRow + 1
NewWks.Cells(oRow, "A").Value = .Cells(iRow, "A").Value
NewWks.Cells(oRow, "B").Value = .Cells(iRow, "B").Value
NewWks.Cells(oRow, "C").Value = .Cells(iRow, "C").Value
NewWks.Cells(oRow, "D").Value = .Cells(iRow, "F").Value
Else
'same person as before.
'don't add "headers"
End If
res = Application.Match(.Cells(iRow, "d").Value, NewWks.Rows(1), 0)
If IsError(res) Then
'shouldn't happen!
MsgBox "Error with row: " & iRow
Else
NewWks.Cells(oRow, res).Value = .Cells(iRow, "e").Value
End If
Next iRow
End With

NewWks.UsedRange.Columns.AutoFit

End Sub

Dave you are a Master! I ran the code by entering the module you suggested.
The only thing is I my system will not give me the student name in an output
of xxx,xxx. I have to put the last and first name in seperate columns
thereby extending the the column out to F (see below). I tried to see in
your code where I could amend it to account for the dataset change but in the
end, I do not have the expertise. Can you amend your code to accomplish the
original intent now accounting for the additional data column?

ColA Col B Col C Col D Col E ColF
Lname Fname Grade Period Room Student ID#
Doe John 12th 1 101 199999999
Doe John 12th 2 102 199999999
Doe John 12th 3 103 199999999
Doe John 12th 4 104 199999999
Doe John 12th 5 105 199999999
Doe John 12th 6 106 199999999
Doe Jane 11th 1 201 299999999
Doe Jane 11th 2 202 299999999

 

[Jcraig713]

I cannot begin to thank you for this Dave. I do however get a compile
message in this line of code:

With .Range("a1:f" & LastRow)
.Sort key1:=.Columns(6), order1:=xlAscending, _
key2:=.Columns(4), order2:=xlAscending,
header:=xlYes
End With

There were 3 orders in the last code you gave.

 

[Dave Peterson]

I realized that I only really cared about putting the ID numbers in order and
within each id, I want the periods in order. I don't really care about the name
(first or last).

But I realized it after I pasted the code into my message. And when I was
cleaning it up, I dropped a line continuation character (on the Key2:= line):

With .Range("a1:f" & LastRow)
.Sort key1:=.Columns(6), order1:=xlAscending, _
key2:=.Columns(4), order2:=xlAscending, _
header:=xlYes
End With

(Those little space-underscore characters are added.)

=======
ps. If I were setting this database up, I would want to type in as little as
possible.

I'd set up another sheet that looked like:

ID LName FName Grade

Then I could type in the ID number in the database and use =vlookup() formulas
to retrieve the names and grades. It might mean fewer typos (different names
for the same person--John Doe, Johnny Doe, J. Doe, ...).

=vlookup(f2,sheet2!A,2,false)
=vlookup(f2,sheet2!A,3,false)
=vlookup(f2,sheet2!A,4,false)

If an error was returned, I'd know that I typed the wrong ID.

I cannot begin to thank you for this Dave. I do however get a compile
message in this line of code:

With .Range("a1:f" & LastRow)
.Sort key1:=.Columns(6), order1:=xlAscending, _
key2:=.Columns(4), order2:=xlAscending,
header:=xlYes
End With

There were 3 orders in the last code you gave.

 

[Jcraig713]

Dave. Thank you so much for your help. The report works as expected and my
secretaries are happy! Thanks very much! Janell