Run a macro X times depending on a cell value

[Melrose0507]

Hello,

I am working on a macro to help adjust information. I have a start date in cell C and end date in cell D. I want to break the line out into one week increments. So if it is 4 weeks, I want to copy the line 4 times and change the start date to the new week. So far I have the below macro. I may be doing this the long way and am not objecting to changing it. The part I need to add is "If cell O on new line is greater than 1 run the copiedrow macro again" I guess I want to loop it to continue copying until all weeks are represented.

Sub Macro1()
'
' Macro1 Macro
'
'
Range("O2").Select
ActiveCell.FormulaR1C1 = "=(RC[-11]-RC[-12])/7"
Selection.Copy
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("P2").Select
ActiveCell.FormulaR1C1 = "=RC[-10]/RC[-1]"
Selection.Copy
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Dim LSearchRow As Integer
LSearchRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
If Range("O" & CStr(LSearchRow)).Value > "1" Then
Range("O" & CStr(LSearchRow)).EntireRow.Copy
Range("O" & CStr(LSearchRow + 1)).EntireRow.Insert Shift:=xlDown
Range("O" & CStr(LSearchRow + 1)).Activate
If Range("O" & CStr(LSearchRow + 1)) > "1" Then
Call CopiedRow
End If
End If
If Range("O" & CStr(LSearchRow)) > "1" Then
LSearchRow = LSearchRow + 2
Else
LSearchRow = LSearchRow + 1
End If
'Loop
Wend

End Sub

Sub CopiedRow()
Range("Q" & (ActiveCell.Row)).FormulaR1C1 = "=RC[-2]-1"
Range("Q" & (ActiveCell.Row)).Copy
Range("O" & (ActiveCell.Row)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("R" & (ActiveCell.Row)).FormulaR1C1 = "=RC[-15]+7"
Range("R" & (ActiveCell.Row)).Copy
Range("C" & (ActiveCell.Row)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

 

[Rhino373]

Do you want to see this on a real calendar where for example your starting date is on a Wednesday so your first week starts on the previous Sunday like a normal calendar or are you starting with the first day and going out 7 days from there to represent a week then wrapping the next 7 days to the next line?

 

[Melrose0507]

I would actually prefer to have the dates be Monday to Sunday. I am creating a tracker and need to break out the amount needed per week.