Timesheet workbook VBA

[Jmoz092]

If possible, I'd like to alter a code that I've been using so that we can apply it to a macro button in the workbook for the user. I want to change it so that after the user enters the last day of the first week that will create the name of the first worksheet, then the VBA recognizes how many more weeks are remaining in the year and creates the appropriate number of sheets for the rest of the year.

i.e., if we make a new workbook for an existing employee, at the beginning of 2018, we'll enter "1-6-18" into the first input box and then the VBA will recognize that we'll need 26 worksheets (2 weeks per worksheet/pay period) and make them

but, if we hire a new employee in the middle of the year and his/her first week ends 5-19-18 (date entered into first input box when making new workbook), the VBA would recognize that we're in the 20th week of the year and that we'll only need to make 16 worksheets for this new employee.

Here's the code I was using. It was designed to duplicate the master time sheet from 8-25-17 to the end of 2017.

Sub YearWorkbookStartAtAug25()
    
    Dim sht As Variant
    Dim sTemp As String
    Dim dSDate As Date


    sTemp = InputBox("Date for the first worksheet:", "End of Week?")
    dSDate = CDate(sTemp) - 1
    
    Application.ScreenUpdating = False
    Worksheets.Add After:=Worksheets(Worksheets.Count), _
      Count:=(11 - Worksheets.Count)
    For Each sht In Worksheets
        sht.Name = Format(dSDate, "mm-dd-yy")
        dSDate = dSDate + 14
    Next sht
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

Sub YearWorkbookStartAtAug25()
    
    Dim sht As Variant
    Dim sTemp As String
    Dim dSDate As Date
    Dim Shts As Long

   
    sTemp = InputBox("Date for the first worksheet:", "End of Week?")
    dSDate = CDate(sTemp) - 1
    Shts = (52 - WorksheetFunction.WeekNum(dSDate)) / 2

    Application.ScreenUpdating = False
    Worksheets.Add After:=Worksheets(Worksheets.Count), _
      Count:=(Shts - Worksheets.Count)
    For Each sht In Worksheets
        sht.Name = Format(dSDate, "mm-dd-yy")
        dSDate = dSDate + 14
    Next sht
    Application.ScreenUpdating = True
End Sub

 

[Jmoz092]

Thanks Fluff. I'm getting an error when I run that. Runtime error, division by zero.

I want to copy Sheet 1 (named "Master") and replicate it as many times as necessary for the user. I wrote the code quite a while ago and am just now revisiting it, for use next year. Have I left out the copy aspect?

 

[Fluff]

Do you have the 2 at the end of this line?

Shts = (52 - WorksheetFunction.WeekNum(dSDate)) / 2

 

[Jmoz092]

Do you have the 2 at the end of this line?

Shts = (52 - WorksheetFunction.WeekNum(dSDate)) / 2

Yes, it's in there just like that.

 

[Jmoz092]

Ok, it was how I was entering the date. It makes new sheets and names them appropriately, but does not copy/paste any data to new sheets

 

[Fluff]

In that case I don't understand why you would get a Divide by zero error, as that is the only part of the code that is doing a division.

 

[Fluff]

Ok, it was how I was entering the date. It makes new sheets and names them appropriately, but does not copy/paste any data to new sheets

Nor did the macro in your op.
Do you want sheet 1 copied in it's entirety, or just bits of it?

 

[Jmoz092]

Sheet1 is named YTD. I need to keep that as is. It is listed as the first sheet in the workbook.

Sheet2 is named Master. I need that sheet copied as many times as necessary, per the user's input.

 

[Fluff]

How about

Sub YearWorkbookStartAtAug25()
    
    Dim Cnt As Long
    Dim sTemp As String
    Dim dSDate As Date
    Dim Shts As Long

   
    sTemp = InputBox("Date for the first worksheet:", "End of Week?")
    dSDate = CDate(sTemp) - 1
    Shts = (52 - WorksheetFunction.WeekNum(dSDate)) / 2

Application.ScreenUpdating = False
   For Cnt = 1 To Shts
      Sheets("Master").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Format(dSDate, "mm-dd-yy")
        dSDate = dSDate + 14
    Next Cnt
End Sub