VBA: Multiplying by a fraction within a loop - vba

Question

My code works below works but I'd like to add one function. I've got a large data sheet with each line repeated three times. Within each set of three I've added a month twice. The purpose is to smooth out forecasted sales into one month and two months beyond the estimated shipping date. Now I'd like to multiply my the values in column E by factors into column F. The original line in each set of three will =50%*E:E in column F, the second line will have =30%*E:E in column F, and the third line will have =20%*E:E in Column F. This process should be repeated continually for every set of three lines. Problem: My current code does give me the correct value, however the values are two cells lower than they need to be. Thanks for any help in advance! My current code is below:
Public Sub DateAdd()
Dim r As Long
Dim l As Long
Dim Quant As Long
Dim dttTemp As Date
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("SalesForce Projects")
Application.ScreenUpdating = False
For r = ws.Range("A" & ws.Rows.Count).End(xlUp).Row To 1 Step -1
With ws.Cells(r, 1).EntireRow
.Copy
.Resize(2).Offset(1, 0).Insert Shift:=xlDown
End With
dttTemp = ws.Cells(r, "S").Value
ws.Cells(r + 1, "S").Value = DateSerial(Year(dttTemp), Month(dttTemp) + 1,
Day(dttTemp))
ws.Cells(r + 2, "S").Value = DateSerial(Year(dttTemp), Month(dttTemp) + 2,
Day(dttTemp))
Next r
Application.ScreenUpdating = True
' This is where my code is bad
For l = ws.Range("A" & ws.Rows.Count).End(xlUp).Row To 1 Step -3
Quant = ws.Cells(l, "E").Value
ws.Cells(l, "F").Value = Cells(l, "E") * 0.5
ws.Cells(l + 1, "F").Value = Cells(l, "E") * 0.3
ws.Cells(l + 2, "F").Value = Cells(l, "E") * 0.2
Next l
End Sub

Answer 1

Why not do it in the first loop like below?
Public Sub DateAdd()
Dim r As Long
Dim l As Long
Dim Quant As Long
Dim dttTemp As Date
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("SalesForce Projects")
Application.ScreenUpdating = False
For r = ws.Range("A" & ws.Rows.Count).End(xlUp).Row To 1 Step -1
With ws.Cells(r, 1).EntireRow
.Copy
.Resize(2).Offset(1, 0).Insert Shift:=xlDown
End With
dttTemp = ws.Cells(r, "S").Value
ws.Cells(r, "F").Value = Cells(r, "E") * 0.5 '\\ First line
ws.Cells(r + 1, "S").Value = DateSerial(Year(dttTemp), Month(dttTemp) + 1, Day(dttTemp))
ws.Cells(r + 1, "F").Value = Cells(r, "E") * 0.3 '\\ Second line
ws.Cells(r + 2, "S").Value = DateSerial(Year(dttTemp), Month(dttTemp) + 2, Day(dttTemp))
ws.Cells(r + 2, "F").Value = Cells(r, "E") * 0.2 '\\ Third line
Next r
Application.ScreenUpdating = True
End Sub

Answer 2

When you say "50% of the value in column E," you could mean the entire value of all 90 in column E or just the value of the three cells in a set. If you mean the first then (I assume that row 1 is headings, so your values start at row 2.) In cell F2 enter the formula
=Sum(E:E)*.5
In cell F3 enter
=SUM(E:E)*.3
In cell F4 enter
=SUM(E:E)*.2
If you mean the other option then enter:
In F2 =Sum(E2:E4)*.5
in F3 =Sum(E2:E4)*.3
In F4 =Sum(E2:e4)*.2
Now select f2:f4. Place your mouse on the bottom right corner and you should see the cursor change to a small black cross. Double-click and the formulas will be replicated down the sheet. If you have more than one sheet to fill then control click on the tab names before starting this process to similtainoiusly copy to all selected sheets.

Answer 3

In this case there is no need to loop backwards. Update the For statement to the following:
For l = 1 to ws.Range("A" & ws.Rows.Count).End(xlUp).Row Step 3
Then it should produce desired results.