Increment Date based on Worksheet number

Hi there,

Have a look at the attached workbook which contains the following code:

Option Explicit


Private Sub CreateWorksheets()

    Const sDATE_CELL_ADDRESS    As String = "B3"
    Const sFIRST_SHEET_NAME     As String = "Start Date"
    Const iNo_OF_SHEETS         As Integer = 90

    Dim dStartDate              As Double
    Dim dDate                   As Double
    Dim wks                     As Worksheet
    Dim i                       As Integer

    Application.ScreenUpdating = False

'       Delete all existing sheets except the "Start Date" sheet
        Application.DisplayAlerts = False
            For Each wks In Worksheets
                If wks.Name <> sFIRST_SHEET_NAME Then
                    wks.Delete
                End If
            Next wks
        Application.DisplayAlerts = True

'       Determine the starting date of the worksheets to be added
        dStartDate = Worksheets(sFIRST_SHEET_NAME).Range(sDATE_CELL_ADDRESS).Value

'       Create and label new worksheets
        For i = 0 To iNo_OF_SHEETS - 1

'           Determine the date of the worksheet to be added
            dDate = dStartDate + i

'           Add new worksheet
            Worksheets.Add After:=Worksheets(Worksheets.Count)

            With ActiveSheet

'               Format and populate the Date cell on the newly-added worksheet
                With .Range(sDATE_CELL_ADDRESS)
                    .ColumnWidth = 12
                    .NumberFormat = "mm/dd/yyyy"
                    .Value = dDate
                End With

'               Assign the appropriate name to the new worksheet
                .Name = Format(dDate, "mm-dd-yyyy")

            End With

        Next i

        Worksheets(sFIRST_SHEET_NAME).Activate

    Application.ScreenUpdating = True

End Sub

I think this will do what you want. The only thing is that worksheet names may not contain the "/" character, so the names of the newly-added sheets have the format "mm-dd-yyyy" rather than "mm/dd/yyyy".

Hope this helps - please let me know how you get on.

Regards,

Greg M

P.S. Do you need a "Confirm Action?" prompt to prevent you from accidentally deleting existing worksheets? If so, just let me know and I can add one.