macro - modification

  • Thread starter Thread starter yshridhar
  • Start date Start date
Y

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
 
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
 
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
 
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
Click to expand...

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
 
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
 
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)
 
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
 
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)
 
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)
 
sheetnames = Array("Jan", "Feb", "Mar", "Apr", "May" etc...
Click to expand...

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


Greg Wilson said:
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")
Click to expand...

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