Copy Dates and Hours Sub

[Guest]

I'm trying to make a sub PrintAttendance (student).

On sheet "Attendance Letter", I want to copy the dates and hours (skipping
days absent) of a selected student. On sheet "Attendance", the student's
names are located A33:A150, their attendance hours X33:IV150 (each row a
different student), and the corresponding dates are located $X$27:$IV$27.

So far, I just have a mess. Please help me!

 

[Guest]

You may want to step through this. I just have DEBUG.PRINT statements for
now. If it's what you need and you have more questions, come back. (this
took some thinking)

Sub AttendanceCode()
Dim Attendance As Range
Dim AttendanceDates As Range
Dim AttDate As Range
Dim Students As Range
Dim Student As Range
Dim StudentDate As Range
Dim mySheet As Worksheet

Dim r As Range
Set mySheet = Sheets("Attendance Letter")

Set Student = mySheet.Range("A33:A150")
Set AttendanceDates = mySheet.Range("X$27:$IV$27")
Debug.Print AttendanceDates.Address
For Each Student In Students
StudentDate = ""
For Each AttDate In AttendanceDates
Attendance = mySheet.Cells(Student.Row, AttDate.Column)
If Not IsEmpty(Attendance) Then
Debug.Print Student.Value, AttDate.Value, Attendance.Value
End If
Next AttDate
Next Student
End Sub


HTH,
Barb Reinhardt

 

[Tom Ogilvy]

Sub ABC()
PrintAttendance "Stew"
End Sub

Sub PrintAttendance(student)
Dim rng As Range, rng1 As Range
Dim rng2 As Range, rng3 As Range
Dim rng4 As Range, res As Variant
Dim sh as Worksheet

With Worksheets("Attendance")
Set rng = .Range("A33:A150")
res = Application.Match(student, rng, 0)
If IsError(res) Then
MsgBox student & " was not found"
Exit Sub
End If
Set rng1 = rng(res)
Set rng2 = Intersect(.Range("X:IV"), rng1.EntireRow)
Set rng3 = Nothing
On Error Resume Next
Set rng3 = rng2.SpecialCells(xlConstants, xlNumbers)
On Error GoTo 0
If rng3 Is Nothing Then
MsgBox student & " has no attendance"
Exit Sub
End If
Set rng4 = Intersect(.Rows(27), rng3.EntireColumn)
set sh = Worksheets("Attendance Letter")
sh.Range("B4").Resize(2,250).ClearContents
rng3.Copy sh.Range("B5")
rng4.Copy sh.Range("B4")
End With
End Sub

worked for me. It pastes the dates and hours to Range B4 and B5 of
Attendance Letter. Adjust to copy to the proper location.

 

[Guest]

Well, it did something.. hum?
I guess I need to make sure it pastes values only. I need the dates and
hours to make two columns starting at C21 (the dates) and D21 (the hours).
So far, the sub only printed the first dates hours, then all #Value! and #NA
horizonally from there.

 

[Guest]

Okay, I've tried to ease things up a little. I've put the selected student's
dates in row 1 and hours in row 2 (X:IV) on the "Attendance Letter" sheet,
but it includes days absent. I want just the days present to appear in three
columns starting with row 21. I'm still new to VBA, here's my pathetic
attempt, which of course has an error.

Sub PrintAttendance()
RowNum = 21
WhichCol = 1
Set sh = Worksheets("Attendance Letter")
For ColLetter = X To IV
If WhichCol = 18 Then
RowCount = 21
End If
If sh.Range(ColLetter & "2").Value > 0 Then
Select Case WhichCol
Case Is <= 17
Range("C" & RowNum).Value = Range(ColLetter & "1").Value
Range("D" & RowNum).Value = Range(ColLetter & "2").Value
RowCount = (RowNum + 1)
WhichCol = (WhichCol + 1)
Case 18 To 34
Range("F" & RowNum).Value = Range(ColLetter & "1").Value
Range("G" & RowNum).Value = Range(ColLetter & "2").Value
RowCount = (RowNum + 1)
WhichCol = (WhichCol + 1)
Case Is > 34
Range("I" & RowNum).Value = Range(ColLetter & "1").Value
Range("J" & RowNum).Value = Range(ColLetter & "2").Value
RowCount = (RowNum + 1)
WhichCol = (WhichCol + 1)
End Select
End If
Next ColLetter
End Sub

 

[Tom Ogilvy]

Sub ABC()
PrintAttendance "Stew"
End Sub

Sub PrintAttendance(student)
Dim rng As Range, rng1 As Range
Dim rng2 As Range, rng3 As Range
Dim rng4 As Range, res As Variant
Dim sh as Worksheet

With Worksheets("Attendance")
Set rng = .Range("A33:A150")
res = Application.Match(student, rng, 0)
If IsError(res) Then
MsgBox student & " was not found"
Exit Sub
End If
Set rng1 = rng(res)
Set rng2 = Intersect(.Range("X:IV"), rng1.EntireRow)
Set rng3 = Nothing
On Error Resume Next
Set rng3 = rng2.SpecialCells(xlConstants, xlNumbers)
On Error GoTo 0
If rng3 Is Nothing Then
MsgBox student & " has no attendance"
Exit Sub
End If
Set rng4 = Intersect(.Rows(27), rng3.EntireColumn)
set sh = Worksheets("Attendance Letter")
rng3.Copy
sh.Range("C5").PasteSpecial xlValues, transpose:=True
rng4.Copy sh.Range("B4")
sh.Range("B5").PasteSpecial xlValues, Transpose:=True
End With
End Sub

 

[Guest]

I'm getting a runtime error 1004,
Paste Special method of Range class failed.