Code to fill down formula

Hello.
I ran the code below but it did not execute at all and instead highlighted in yellow a part of the code (see red font). This is the workbook i'm working with Fill Down Formula.xlsm

Sub filldownformula()
Dim ws As Worksheet:    Set ws = Sheets("Sheet1")
Dim lr As Long
Dim lc As Long
Dim rcell As Range

lr = ws.Range("A" & Rows.Count).End(xlUp).Row
lc = ActiveSheet.UsedRange.Columns.Count

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each rcell In ws.Range(Cells(18, lc - 1))
rcell.FormulaR1C1 = "=RC[-2]*" & ws.Range("A1").Value
Next rcell

ws.Range(Cells(18, lc)).FormulaR1C1 = "=RC[-2]*RC[-1]"

ws.Range(Cells(18, lc - 1)).Select
ws.Range(Cells(18, lc)).Select
Selection.Resize(lr - 18 + 1, 2).FillDown

Cells(lr, lc).Formula = "=SUM(" & Cells(18, lc).Address & ":" & Cells(lr + 1, lc).Address & ")"

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Any ideas?
Thanks.