Copy Headers based on id# and data

[sharpie23]

Ok here is the problem I am having, I have a pretty advanced Gradebook
in excel. I want to add a page that will print a report for a student
that shows all missing assignments.

My HW page is set up with IDs in Column C and Row 5 contains all
Assignment names. Obviously below each assignment name is a list of
points for each student.

On sheet 7 I have a the sheet formated mostly the way I want it. When
I place an ID number in C7 it will update the page with all of that
students information.

I now need a code that will take the ID # from C7
Then,
Search through sheet 2 column C and find that ID number......(Here's
where I got stuck)....Then search along that Row and find all of the
Zeros. Every time it finds a Zero the program must copy the Header (in
Row 5) corresponding to that zero and copy it to sheet 7

The list should then compile down. Starting at say A 11, then
A12....and so on.

I know how to do most of these procedures, but doing them all together
has me confused.

Thanks,
Ryan Sharp

 

[Ivyleaf]

Hi Ryan,

This is probably messy code, but it should do the job for you:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim StudentID
Dim StudentRow As Integer
Dim StudentRange As Range

If Target.Address = "$C$7" Then

StudentID = Worksheets(2).Range("C7").Value
StudentRow = Application.WorksheetFunction.Match(StudentID,
Worksheets(1).Range("C:C"), 0)
Set StudentRange = Worksheets(1).Cells(StudentRow, 4)
Set StudentRange = StudentRange.Resize(1,
StudentRange.CurrentRegion.Columns.Count - 1)
Worksheets(2).Range("A:A").ClearContents
s = 11
For Each c In StudentRange.Cells
If c = 0 Then
Worksheets(2).Cells(s, 1) = c.Offset(5 - StudentRow,
0).Value
s = s + 1
End If
Next

End If
End Sub

If you didn't want it in the SheetChange event, you could put it in a
module and just put a button on the sheet somewhere.
I wrote it with the 'HW' page on sheet 1, and the report on sheet 2, so
you will have to adjust that in the macro.

Hope it helps,
Ivan.

 

[Dave Peterson]

I would think that the student ID would sufficient to identify the student, but
it would be difficult to work with. I'm guessing that you have another field on
your HW worksheet that contains the student name.

This code copies the value from column B (modify if that's not required or not
correct). And instead of you typing in the id and doing it one by one, it just
looks at all the data.

Option Explicit
Sub testme()

Dim HWWks As Worksheet
Dim RptWks As Worksheet

Dim HeaderRow As Long
Dim IDCol As Long

Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim iRow As Long
Dim iCol As Long
Dim oRow As Long

Set HWWks = Worksheets("HW")
Set RptWks = Worksheets("MissingHW")

With HWWks
HeaderRow = 5
FirstRow = HeaderRow + 1
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

IDCol = 3 'C
FirstCol = IDCol + 1
LastCol = .Cells(HeaderRow, .Columns.Count).End(xlToLeft).Column

For iRow = FirstRow To LastRow
If Application.CountIf(.Range(.Cells(iRow, FirstCol), _
.Cells(iRow, LastCol)), 0) = 0 Then
'no missing scores, skip this row
Else
Call CleanUpRptWks(RptWks)
oRow = 11 'start the output on row 11

'add id
RptWks.Range("C7").Value = .Cells(iRow, IDCol).Value

'add name from somewhere??? (to the left of the ID column???
RptWks.Range("c8").Value = .Cells(iRow, IDCol - 1).Value

For iCol = FirstCol To LastCol
If IsEmpty(.Cells(iRow, iCol).Value) Then
'do nothing
Else
If IsNumeric(.Cells(iRow, iCol).Value) Then
If .Cells(iRow, iCol).Value = 0 Then
'found one
RptWks.Cells(oRow, "A").Value _
= .Cells(HeaderRow, iCol).Value
oRow = oRow + 1
End If
End If
End If
Next iCol

'save some paper until you're ready!
RptWks.PrintOut preview:=True

End If
Next iRow
End With

'fix up report worksheet
Call CleanUpRptWks(RptWks)

End Sub

Sub CleanUpRptWks(wks As Worksheet)
With wks
.Range("C7").ClearContents
.Range("C8").ClearContents
.Range("A11:A" & .Rows.Count).ClearContents
End With
End Sub