ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   macro - modification (https://www.excelbanter.com/excel-discussion-misc-queries/174767-macro-modification.html)

yshridhar

macro - modification
 
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

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


yshridhar

macro - modification
 
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" wrote:

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


Greg Wilson

macro - modification
 
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" wrote:

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" wrote:

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

macro - modification
 
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

"Greg Wilson" wrote:

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" wrote:

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" wrote:

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


Bob Phillips

macro - modification
 
If Range("C2").Value < "" Then
On Error Resume Next
Set ws = Worksheets(Range("C2").Value)
If ws Is Nothing Then
Worksheets.Add(befo=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" wrote in message
...
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

"Greg Wilson" wrote:

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" wrote:

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" wrote:

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

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

Worksheets.Add(befo=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" wrote:

If Range("C2").Value < "" Then
On Error Resume Next
Set ws = Worksheets(Range("C2").Value)
If ws Is Nothing Then
Worksheets.Add(befo=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" wrote in message
...
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

"Greg Wilson" wrote:

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" wrote:

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" wrote:

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





Bob Phillips

macro - modification
 
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)



"yshridhar" wrote in message
...
Bob I learnt how to add new worksheet with a name from you suggestion.

Worksheets.Add(befo=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" wrote:

If Range("C2").Value < "" Then
On Error Resume Next
Set ws = Worksheets(Range("C2").Value)
If ws Is Nothing Then
Worksheets.Add(befo=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" wrote in message
...
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

"Greg Wilson" wrote:

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" wrote:

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" wrote:

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







Greg Wilson

macro - modification
 
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)
On Error GoTo 0
End Function


"yshridhar" wrote:

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

Worksheets.Add(befo=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" wrote:

If Range("C2").Value < "" Then
On Error Resume Next
Set ws = Worksheets(Range("C2").Value)
If ws Is Nothing Then
Worksheets.Add(befo=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" wrote in message
...
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

"Greg Wilson" wrote:

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" wrote:

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" wrote:

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





Dana DeLouis

macro - modification
 

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


"Greg Wilson" wrote in message
...
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

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

"Bob Phillips" wrote:

If Range("C2").Value < "" Then
On Error Resume Next
Set ws = Worksheets(Range("C2").Value)
If ws Is Nothing Then
Worksheets.Add(befo=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" wrote in message
...
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

"Greg Wilson" wrote:

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" wrote:

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" wrote:

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






All times are GMT +1. The time now is 07:12 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com