View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
Greg Wilson Greg Wilson is offline
external usenet poster
 
Posts: 747
Default macro - modification

Try:

Sub k()
Dim r As Range
Dim i As Integer, m As Integer, d As Integer
Dim msg As String, ttl As String, nm As String
Dim sheetnames As Variant

sheetnames = Array("Jan", "Feb", "Mar", "Apr", "May", _
"Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
For i = 0 To 11
nm = sheetnames(i)
If Not SheetExists(nm) Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheetnames(i)
End If
Next

With Sheets("Data")
With .Range("C2")
If Not IsDate(.Value) Then
msg = "Error: Date not entered in cell C2"
ttl = "Student Attendance"
MsgBox msg, vbCritical, ttl
Exit Sub
End If
m = Month(.Value)
d = Day(.Value)
End With
Set r = .Range(.Cells(3, 5), .Cells(3, 5).End(xlDown))
End With
With Sheets(sheetnames(m - 1)).Cells(3, d).Resize(r.Count)
.Value = r.Value
End With
Set r = Nothing
End Sub

Private Function SheetExists(shtnm As String) As Boolean
Dim x As String
On Error Resume Next
x = ThisWorkbook.Sheets(shtnm).Name
SheetExists = (Err = 0)
On Error GoTo 0
End Function

Greg