How to create a 52 week planner from this data.... Macro?

Hi shuboarder,

Here's a routine that creates a new "Planning Calendar" sheet from the rows in the ActiveSheet where the frequency is in days and the calendar rows extending for 52 weeks from each Start Date:

Sub CreatePlanDates()
Dim ws As Worksheet, cel As Range, i As Long

Application.ScreenUpdating = False

On Error Resume Next
Set ws = Worksheets("Planning Calendar")
On Error GoTo 0

With ActiveSheet
    If ws Is Nothing Then
        Worksheets.Add After:=Worksheets(.Name)
        Set ws = ActiveSheet
        ws.Name = "Planning Calendar"
    Else
        ws.UsedRange.Clear
    End If
   
    ws.Range("A1:G1").Value = .Range("A1:G1").Value
   
    For Each cel In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
        With ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
            i = (7 / cel.Offset(0, 5).Value) * 52
            .Resize(i, 7).Value = cel.Resize(1, 7).Value
            .Offset(1, 4).Resize(i - 1, 1).FormulaR1C1 = "=R[-1]C[2]"
            .Offset(1, 5).Resize(i - 1, 1).FormulaR1C1 = "=R[-1]C"
            .Offset(1, 6).Resize(i - 1, 1).FormulaR1C1 = "=RC[-2]+RC[-1]"
        End With
    Next cel
   
    ws.UsedRange.Value = ws.UsedRange.Value
   
End With

Application.ScreenUpdating = False

End Sub

Let me know how this works for you.

Jim

Hi Jim,

wow, thanks that works great!

Just a few improvements if possible?

1. I have added a column either side of the description column to provide additional information
Can the range simply be changed to accomodate this change?

2. Could the NextRun date be sorted ascending?

3. Additionally, could each month be automatically be placed on a separate worksheet?
i.e. Planning August 2006 w/s contains all lines for August

Thanks for your help!

Thanks! - it works great!