Monthly Time Sheet

Akashwani

Akashwani

Well-known Member
Joined
Mar 14, 2009
Messages
2,911
Good day,

I was helping someone here....

http://www.mrexcel.com/forum/showthread.php?t=546934

Out of curiosity :rofl: I thought that I would create a Template so that it could be copied and used for the year. I have put together the following code from recording Macros and some MrExcel VBA....

Code: 
Sub AddMonthSheets()
Application.ScreenUpdating = False
''This currently selects the cells in A2:A13 on sheet Criteria.
Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
''The following creates new sheets based on the names in the above range
For Each Cell In Selection
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Cell.Value
Next Cell

''This copies sheet Template
    Sheets("Template").Select
    Cells.Select
    Selection.Copy
    
''Change this array to suit the names listed in A2:A13 on sheet Criteria
''This selects the sheets below and pastes the template on to each sheet

    Sheets(Array("January", "February", "March", "April", "May", "June", "July", "August", _
        "September", "October", "November", "December")).Select
    Sheets("January").Activate
    ActiveSheet.Paste
    Range("A1").Select
    
    Sheets("Template").Select
    Application.CutCopyMode = False
    Range("A1").Select
    Sheets("Criteria").Select
    Range("A1").Select

Application.ScreenUpdating = True
End Sub

I know that the Template and code are not perfect, so no laughing or mockery please :) I am open to suggestions on the following....

1. How can the code above be changed so the Sheets Array doesn't have to be manually changed IF someone wants 6 months or 24 months?
2. What code would be required to put the dates in column A for each work sheet based on the sheet name, eg sheet name January would have code to create the dates in column A for that month.

Sample of Template....

Excel Workbook
ABCDEFGHIJKLMN
1",CELL("filename",A1))+1,256)]Template*************
2DateDayTime-InTime-OutDaily Total HrsReg. Hrs (8 hr)Week OTW/E OTHoliday OTTardinessSick LeaveAbsenceUnpaid LeaveHoliday
3**************
4**************
5**************
Template



There is a file here for anyone interested in using this Template or who would like to look at it and make any suggestions.....

MonthlyTimeSheet.xls

This file contains the above VBA ONLY.

Thank you for viewing this and any ideas will be greatly appreciated.

Ak
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
Try this code method, with proper dates in Criteria A2:A13

Code: 
    With Sheets("Criteria")
        For a = 2 To 13
            destsht = CStr(Format(.Range("A" & a).Value, "Mmmm yyyy"))
        On Error Resume Next
            If Not Worksheets(destsht).Name = destsht Then
                Sheets("Template").Copy After:=Sheets(Sheets.Count)
                Sheets("Template (2)").Name = destsht
            End If
        Next
    End With

Note that it's not perfect, just a quick example with the loop boundary hardcoded.
 
Upvote 0
Hi Jason,

What the .... that has really messed up my workbook now.

Only kidding :rofl: that is a great addition, option2 code is....

Code: 
Sub Option2 ()
Application.ScreenUpdating = False
''This currently selects the cells in A2:A13 on sheet Criteria.
Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
''The following creates new sheets based on the names in the above range
With Sheets("Criteria")
        For a = 2 To 13
            destsht = CStr(Format(.Range("A" & a).Value, "Mmmm yyyy"))
        On Error Resume Next
            If Not Worksheets(destsht).Name = destsht Then
                Sheets("Template").Copy After:=Sheets(Sheets.Count)
                Sheets("Template (2)").Name = destsht
            End If
        Next
    End With

Application.ScreenUpdating = True
End Sub

I now need to come up with a new formula for column A on sheet Template so that the dates for each worksheet created is automatically listed.

Thanks for your contribution Jason, greatly appreciated.

Ak
 
Upvote 0
Those selection lines you added will do nothing Ak, the loop will still run and take priority.

Try this (without any changes to the code) on various date ranges in Criteria, including a variation on the number of months. Note that it will not delete sheets if you remove dates from the criteria and re-run the code, I've deliberately excluded that to avoid any risk of lost data.

Code: 
Application.ScreenUpdating = False
    With Sheets("Criteria")
        For a = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            sdate = .Cells(a, 1).Value
            destsht = CStr(Format(sdate, "Mmmm yyyy"))
        On Error Resume Next
            If Not Worksheets(destsht).Name = destsht Then
                Sheets("Template").Copy After:=Sheets(Sheets.Count)
                Sheets("Template (2)").Name = destsht
            End If
                dmonth = Month(sdate)
            With Sheets(destsht)
                For d = 0 To 30
                    If dmonth <> Month(sdate + d) Then Exit For
                        .Cells(d + 2, 1).Value = Format(sdate + d, "mm/dd/yy")
                Next
                .Columns(1).AutoFit
            End With
        Next
    End With
Application.ScreenUpdating = True
 
Upvote 0
Hi Jason,

Yep that works great also, thanks for your solutions and interest in this.

Those selection lines you added will do nothing Ak
Click to expand...

:oops: I forgot to remove that, honestly ;)

Just out of curiosity I entered the criteria range as text and your code ran perfectly, the only difference being it didn't add the year to the sheet tab, which for some people may not be a requirement anyway.

Thanks again Jason. much appreciated.

Ak
 
Upvote 0
It almost runs perfectly with text in the criteria range, but not quite.

The code can't create a valid date from that so the part that fills the dates in column A doesn't execute, it just leaves what (if anything) was copied from the template.

When I wrote that into the code I was assuming that column A would be empty in the template, if it's not it could leave some stray wrong dates in copied sheets anyway.

If you're not sure what I mean, specify February in criteria, both with text, and with a valid date, then check column A in the sheets the code creates.
 
Upvote 0
Hi Jason,

:rofl: How I wish I was that VBA smart.

Record macro, get confused, surf net/MrExcel, post new thread for help, that's my VBA skill level :(

Thanks for explaining everything to me Jason, you have helped me greatly.

To anyone reading this and planning on using the file, you will need to change the VBA to this....

Code: 
Sub AddMonthSheets()
Application.ScreenUpdating = False
    With Sheets("Criteria")
        For a = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            sdate = .Cells(a, 1).Value
            destsht = CStr(Format(sdate, "Mmmm yyyy"))
        On Error Resume Next
            If Not Worksheets(destsht).Name = destsht Then
                Sheets("Template").Copy After:=Sheets(Sheets.Count)
                Sheets("Template (2)").Name = destsht
            End If
                dmonth = Month(sdate)
            With Sheets(destsht)
                For d = 0 To 30
                    If dmonth <> Month(sdate + d) Then Exit For
                        .Cells(d + 3, 1).Value = Format(sdate + d, "mm/dd/yy")
                Next
                .Columns(1).AutoFit
            End With
        Next
    End With
Application.ScreenUpdating = True
End Sub

Enter the dates in Column A of sheet Criteria as dd/mm/yyyy.
Delete the formulas in column A of sheet Template.

You are good to go.

Thanks again Jason.

Ak
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Generating Reports in Word Using Data in Excel
Replies
1
Views
408
Dan_W
D
P
  • Question Question
Checking for Worksheets that already exist
2
Replies
11
Views
324
Logit
Logit
O
  • Solved
Copy a sheet which is a template based on a drop down list and rename each copied tab with each value in the drop down list
2 3
Replies
21
Views
1K
dmt32
D
A
  • Solved
VBA to copy a template from one sheet to another based on dropdown
2
Replies
10
Views
704
altizerc2196
A
E
  • Question Question
VBA - Create a new sheet + hyperlink name
Replies
3
Views
429
excelnewbie990
E

Forum statistics

Threads
1,224,591
Messages
6,179,768
Members
452,940
Latest member
rootytrip

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top