Macro to advance multiple cells by same interval

[Caitlin535]

Hello!
I have a series of timesheets I've made in Excel. Each worksheet contains a two-week pay period, with the dates in cells D3 through D16 (ie, 14 days).

To make the next pay period sheet I've just been making a copy of the last worksheet and then manually changing the dates (well, changing the first and then filling the column down).

Is it possible to make a macro such that - after making a copy of the last worksheet - I can (in one click) advance each of cells D3 through D16 by 14 days? IE, enter the correct dates for the next pay period in one click? Hope that makes sense . . .

Caitlin

 

[lrobbo314]

Try this.

Sub NewPP()
Application.ScreenUpdating = False
ActiveSheet.Copy After:=Sheets(Sheets.Count)
Dim ws As Worksheet: Set ws = Sheets(Sheets.Count)
Dim r As Range: Set r = ws.Range("D3:D16")


r.Value = Evaluate(Replace("IF({1},@+14)", "@", r.Address))
Application.ScreenUpdating = False
End Sub

 

[JoeMo]

You can assign this macro to a button on the sheet that you will make a copy of. When you click the button a new copy will be made and the dates in D3:D16 will each be advanced by 14 days. The button will carry to the new sheet to use again in 14 days ....

Sub ChangeTimesheetDates()
Dim c As Range
Application.ScreenUpdating = False
ActiveSheet.Copy after:=Sheets(Sheets.Count)
With ActiveSheet
    For Each c In .Range("D3:D16")
        c.Value = c.Value + 14
    Next c
    .Columns("D").AutoFit
End With
Application.ScreenUpdating = True
End Sub

 

[lrobbo314]

A more streamlined version of my previous post.

Sub NewPP()
Application.ScreenUpdating = False

ActiveSheet.Copy After:=Sheets(Sheets.Count)

With Range("D3:D16")
    .Value = Evaluate(Replace("IF({1},@+14)", "@", .Address))
End With

Application.ScreenUpdating = False
End Sub