Error in macro to create a macro that populates columns with a formula.

[dmitchell4]

I'm trying to create a macro that will add columns with a header, and add a formula to each column.

This is the code I have so far.

Sub addcolumn()
Dim Formulas(1 To 5) As Variant
Dim LastRow As Long
Worksheets("Combined Pivot").Range("R:V").EntireColumn.Insert
Worksheets("Combined Pivot").Range("R2").Formula = "Current Value"
Worksheets("Combined Pivot").Range("S2").Formula = "Excess Value"
Worksheets("Combined Pivot").Range("T2").Formula = "Surplus Value"
Worksheets("Combined Pivot").Range("U2").Formula = "Surplus ND Value"
Worksheets("Combined Pivot").Range("V2").Formula = "Obsolete Value"
With ThisWorkbook.Worksheets("Combined Pivot")
Formulas(1) = "=IFERROR(IF(SUM(L3:N3)<k3,(sum(l3:n3)*i3),k3*i3),0)"
Formulas(2) = "=IFERROR(IF(O3<(K3-(L3+M3+N3)),O3*I3,IF((K3-(L3+M3+N3))>0,(K3-(L3+M3+N3))*I3,0)),0)"
Formulas(3) = "=IFERROR(IF(P3<(K3-(L3+M3+N3+O3)),P3*I3,IF((K3-(L3+M3+N3+O3))>0,(K3-(L3+M3+N3+O3))*I3,0)),0)"
Formulas(4) = "=IFERROR(IF(Q3<(K3-(L3+M3+N3+O3+P3)),Q3*I3,IF((K3-(L3+M3+N3+O3+P3))>0,(K3-(L3+M3+N3+O3+P3))*I3,0)),0)"
Formulas(5) = "=IFERROR(IF(SUM(L3:Q3)=0,K3*I3,0),0)"
End With
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("R3:R" & LastRow).FillDown
End Sub

When debugging, and I get to this line, an error: Subscript out of range.

With ThisWorkbook.Worksheets("Combined Pivot")

Am I missing some code? I've checked that the spelling is 100% correct, it's not an issue with that. I'm very new to VBA so I'm not quite sure where to proceed from here.</k3,(sum(l3:n3)*i3),k3*i3),0)"

 

[dmitchell4]

I've updated my code and have it all working now. This is what is so far:

Sub addcolumn()
Dim Formulas(1 To 5) As Variant
Dim LastRow As Long
Worksheets("Combined Pivot").Range("R:V").EntireColumn.Insert
Worksheets("Combined Pivot").Range("R2").Formula = "Current Value"
Worksheets("Combined Pivot").Range("S2").Formula = "Excess Value"
Worksheets("Combined Pivot").Range("T2").Formula = "Surplus Value"
Worksheets("Combined Pivot").Range("U2").Formula = "Surplus ND Value"
Worksheets("Combined Pivot").Range("V2").Formula = "Obsolete Value"
With ActiveWorkbook.Worksheets("Combined Pivot")
Formulas(1) = "=IFERROR(IF(SUM(L3:N3)<K3,(SUM(L3:N3)*I3),K3*I3),0)"
Formulas(2) = "=IFERROR(IF(O3<(K3-(L3+M3+N3)),O3*I3,IF((K3-(L3+M3+N3))>0,(K3-(L3+M3+N3))*I3,0)),0)"
Formulas(3) = "=IFERROR(IF(P3<(K3-(L3+M3+N3+O3)),P3*I3,IF((K3-(L3+M3+N3+O3))>0,(K3-(L3+M3+N3+O3))*I3,0)),0)"
Formulas(4) = "=IFERROR(IF(Q3<(K3-(L3+M3+N3+O3+P3)),Q3*I3,IF((K3-(L3+M3+N3+O3+P3))>0,(K3-(L3+M3+N3+O3+P3))*I3,0)),0)"
Formulas(5) = "=IFERROR(IF(SUM(L3:Q3)=0,K3*I3,0),0)"
.Range("R3:V3").Formula = Formulas
.Range("R:V").NumberFormat = "$#,##0;[Red]($#,##0"
End With
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("R3:V" & LastRow).FillDown
End Sub

My only problem now is that the formula extends too far down. Is there a way I can make it extend only as far as there is data in column Q?

 

[dmitchell4]

For some reason only part of the code was picked up. Here it is now.

Sub addcolumn()
Dim Formulas(1 To 5) As Variant
Dim LastRow As Long
Worksheets("Combined Pivot").Range("R:V").EntireColumn.Insert
Worksheets("Combined Pivot").Range("R2").Formula = "Current Value"
Worksheets("Combined Pivot").Range("S2").Formula = "Excess Value"
Worksheets("Combined Pivot").Range("T2").Formula = "Surplus Value"
Worksheets("Combined Pivot").Range("U2").Formula = "Surplus ND Value"
Worksheets("Combined Pivot").Range("V2").Formula = "Obsolete Value"
With ActiveWorkbook.Worksheets("Combined Pivot")
Formulas(1) = "=IFERROR(IF(SUM(L3:N3)<K3,(SUM(L3:N3)*I3),K3*I3),0)"
Formulas(2) = "=IFERROR(IF(O3<(K3-(L3+M3+N3)),O3*I3,IF((K3-(L3+M3+N3))>0,(K3-(L3+M3+N3))*I3,0)),0)"
Formulas(3) = "=IFERROR(IF(P3<(K3-(L3+M3+N3+O3)),P3*I3,IF((K3-(L3+M3+N3+O3))>0,(K3-(L3+M3+N3+O3))*I3,0)),0)"
Formulas(4) = "=IFERROR(IF(Q3<(K3-(L3+M3+N3+O3+P3)),Q3*I3,IF((K3-(L3+M3+N3+O3+P3))>0,(K3-(L3+M3+N3+O3+P3))*I3,0)),0)"
Formulas(5) = "=IFERROR(IF(SUM(L3:Q3)=0,K3*I3,0),0)"
.Range("R3:V3").Formula = Formulas
.Range("R:V").NumberFormat = "$#,##0;[Red]($#,##0"
End With
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("R3:V" & LastRow).FillDown
End Sub

 

[dmitchell4]

The code I had worked.