macro - modification

[yshridhar]

Hi All
I have received the following macro from Greg Wilson. I copies down a range
into respective month sheet and date column based on date (C2). I created
the month sheets manually.
What i need is the macro should check whether the month sheet is created or
not. If it is not, create month sheet and copy else copy the range.


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

sheetnames = Array("Jan", "Feb", "Mar", "Apr", "May", _
"Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

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

With regards
Sreedhar

 

[Greg Wilson]

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

 

[yshridhar]

Thank you Greg.
What actually I need is the macro has to create month sheet based on the
date in C2 not create all the month-sheets at a time.
If the sheet month.C2 is not exist then create and copy or just copy the data
With regards
Sridhar

 

[Greg Wilson]

yshridhar,

The code first checks to see if ALL the month sheets are there. It only
creates a sheet if it can't find it. The SheetExists function returns False
only if the sheet doesn't exist.

If Not SheetExists(nm) Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheetnames(i)
End If

I don't see any difference between creating them if they don't exist at the
beginning or creating them if/when it can't find them during the copy routine.

Greg

 

[yshridhar]

Yes Greg what you said is true. My idea is to create the sheet at the
begining of the month. Suppose 1/3/2008, march, if the sheet is not there
create sheet. Because I enter the attendance on datewise. So i thought the
file size won't increase as A and B columns in month sheet i enter IdNo,
Student Name.
With regards
Sreedhar

 

[Bob Phillips]

If Range("C2").Value <> "" Then
On Error Resume Next
Set ws = Worksheets(Range("C2").Value)
If ws Is Nothing Then
Worksheets.Add(before:=Worksheets(Worksheets.Count)).Name =
Range("C2").Value
End If
On Error GoTo 0
End If

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[yshridhar]

Bob I learnt how to add new worksheet with a name from you suggestion.

Worksheets.Add(before:=Worksheets(Worksheets.Count)).Name = sheetnames(m - 1)

Just i have added this line to my original macro.
Now what i want is if the sheet is already exists it has to resume the copy
procedure.
I am not good at VB. Help me pls
With regards
Sreedhar

 

[Bob Phillips]

I gave you that in essence. It creates the sheet if it doesn't exist, so
just add an Else and put the other code in there.

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Greg Wilson]

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

sheetnames = Array("Jan", "Feb", "Mar", "Apr", "May", _
"Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

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
If Not SheetExists(sheetnames(m - 1)) Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheetnames(m - 1)
End If
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)

 

[Dana DeLouis]

sheetnames = Array("Jan", "Feb", "Mar", "Apr", "May" etc...

As a side note, recent versions of Excel allow us to eliminate this array
with the function "MonthName"
This returns True.

Sub Demo()
Dim m
m = 3
Debug.Print MonthName(m, True) = "Mar"
End Sub

--
HTH :>)
Dana DeLouis

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

sheetnames = Array("Jan", "Feb", "Mar", "Apr", "May", _
"Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

With Sheets("Data")

<snip>

 

[yshridhar]

Thanks Bob. Finally i could able to smell the essence of your suggestion.
It solved my problem.
With Regards
Sreedhar