I am trying to autofill a date series over 26 worksheets in one workbook. I have a time accounting workbook for 2014 that I want to setup for 2015. Each worksheet is one pay period with two weeks per pay period. example: Sheet1 $A$5:$A$9 week one
& $A$11:$A$15 week two
, Sheet2 $A$5:$A$9 week three
& $A$11:$A$15 week four
, etc. etc.. I want to be able to select a start date and use a series autofill
command to fill in the dates for each range throughout the workbook. It just so happens that for 2015 the first date is 1/11/2015 and the last date would be 1/9/2016.
Edit
This is my current code I Would have to repeat the last 6 lines 24 times, changing the sheet referance in lines 1 and 3 each time. Is there any way to shorten this?
Sheets("pp03").Select
myValue = InputBox("Enter Start Date")
Range("A8").Value = myValue
Range("A8:A14,A16:A22").Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Trend:=False
Range("D9").Select
Sheets("pp04").Select
Range("A8").Select
ActiveCell.FormulaR1C1 = "=pp03!R[14]C+1"
Range("A8:A14,A16:A22").Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Trend:=False
Range("D9").Select
Warning: The macro below will delete the contents of any worksheets within its workbook.
The macro recorder is a great way to discover the VBA statement that matches a keyboard function but it does not produce good code. The principal reason is that it is recording your actions one by one; it does not know your objective.
Rather than ask lots of questions which would probably not make much sense if your VBA is limited, I have written a macro that creates what I would want. Try it out in a new workbook and ask questions as necessary.
If you are going to try writing macros, you must learn the basics of VBA. There are many online tutorials: search for “Excel VBA tutorial”. I prefer books. I visited my local library, borrowed a few Excel VBA Primers and then bought the one that I preferred.
Option Explicit
Sub SetDates()
Dim DateStart As Date
Dim DateEnd As Date
Dim I As Long ' Temporary integer
Dim InxWsht As Long
Dim RowCrnt As Long
Dim StrStart As String
Dim StrEnd As String
Dim Title As String
Title = "Fill worksheet with dates"
StrStart = ""
StrEnd = ""
Do While True
' Loop until have acceptable start and end date
Do While True
' Loop until have acceptable start date
StrStart = InputBox("Please enter start date", Title, StrStart)
If StrStart = "" Then
' User has pressed cancel
Exit Sub
End If
If IsDate(StrStart) Then
DateStart = CDate(StrStart)
I = Weekday(DateStart, vbSunday)
If I = vbSunday Then
' Have acceptable start date
Exit Do
End If
Call MsgBox("Excel tells me " & StrStart & " is a " & _
WeekdayName(I, False, vbSunday) & _
" but I need a Sunday. Please try again.", vbOKOnly, Title)
Else
Call MsgBox("Excel is unable to interpret " & StrStart & _
" as a date. Please try again.", vbOKOnly, Title)
End If
Loop
'Debug.Print StrStart & "->" & DateStart
Do While True
' Loop until have acceptable end date
StrEnd = InputBox("Start date is " & Format(DateStart, "dddd mmm, d yyyy") & _
"." & vbLf & "Please enter end date", Title, StrEnd)
If StrEnd = "" Then
' User has pressed cancel
Exit Sub
End If
If IsDate(StrEnd) Then
DateEnd = CDate(StrEnd)
I = Weekday(DateEnd, vbSunday)
If I = vbSaturday Then
' Have acceptable end date
Exit Do
End If
Call MsgBox("Excel tells me " & StrEnd & " is a " & WeekdayName(I, False, vbSunday) & _
" but I need a Saturday. Please try again.", vbOKOnly, Title)
Else
Call MsgBox("Excel is unable to interpret " & StrEnd & _
" as a date. Please try again.", vbOKOnly, Title)
End If
Loop
Debug.Print StrEnd & "->" & DateEnd
If DateStart < DateEnd Then
Exit Do
End If
Call MsgBox("Start date " & StrStart & " is after end date " & _
StrEnd & ". Please try again.", vbOKOnly, Title)
Loop
' Replace existing names of worksheets in case any existing name
' matches one I am able to create
For InxWsht = 1 To Worksheets.Count
Worksheets(InxWsht).Name = InxWsht
Next
InxWsht = 1
Do While DateStart < DateEnd
If InxWsht > Worksheets.Count Then
' There is no existing unused worksheet so create new
' one and place after any existing worksheets.
Worksheets.Add After:=Worksheets(Worksheets.Count), Count:=1
End If
With Worksheets(InxWsht)
' Delete any existing contents
.Cells.EntireRow.Delete
' Name sheet for first day
.Name = Format(DateStart, "mmm d")
For RowCrnt = 3 To 9
.Cells(RowCrnt, "A").Value = Format(DateStart, "dddd mmm, d")
DateStart = DateAdd("d", 1, DateStart)
Next
For RowCrnt = 11 To 17
.Cells(RowCrnt, "A").Value = Format(DateStart, "dddd mmm, d")
DateStart = DateAdd("d", 1, DateStart)
Next
.Columns("A").AutoFit
End With
' Advance to next worksheet
InxWsht = InxWsht + 1
Loop
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.