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

 

[Jmoz092]

That works.

Can I just add:

Sheets("Master").Delete

after:

     Next Cnt

I don't want the Master sheet to be available for confusion to the timekeeper.

 

[Fluff]

That would be fine, but I'd recommend turning alerts off first, otherwise you'll get asked if you want to delete the sheet

   Application.DisplayAlerts = False
   Sheets("Master").Delete
   Application.DisplayAlerts = True

 

[Jmoz092]

Thanks Fluff, works very well!!

 

[Fluff]

Glad to help & thanks for the feedback

 

[Jmoz092]

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

Hi @Fluff. I've been asked to change this to daily. How can I change the code to copy the master and make copies of it for each workday in the year, from the date entered in the inputBox (sTemp) until the last work day of the year?

 

[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)
    Shts = (365 - Day(dSDate))

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

As I don't know when your last working day is, this will run till 31 Dec (Except for leap years)

 

[Jmoz092]

Thanks Fluff. What are the options to change :

Shts = (365 - Day(dSDate))

is it possible to do something like workday function?

 

[Fluff]

Very possibly, but I'm not sure how.

 

[Jmoz092]

it wasn't working when I typed it into the VBA, I wonder if its just a worksheet function? I'll dig more in to it and post back what I find.

Thanks!!

 

[Fluff]

How about

Sub YearWorkbookStartAtAug25()
    
   Dim Cnt As Long
   Dim sTemp As String
   Dim dSDate As Date
   Dim Shts As Long
   Dim eDate As Date
   
   sTemp = InputBox("Date for the first worksheet:", "End of Week?")
   dSDate = CDate(sTemp)
   eDate = "31/12/" & Year(dSDate)
   Shts = WorksheetFunction.NetworkDays(dSDate, eDate)
   
   Application.ScreenUpdating = False
   For Cnt = 1 To Shts
      If WorksheetFunction.WorkDay(dSDate - 1, 1) = dSDate Then
         Sheets("SBD").Copy after:=Sheets(Sheets.Count)
         ActiveSheet.Name = Format(dSDate, "mm-dd-yy")
         dSDate = dSDate + 1
      Else
         dSDate = dSDate + 1
         Cnt = Cnt - 1
      End If
   Next Cnt
   End Sub