Hello, I am trying to find a better way to accomplish this task. I have a template worksheet that is copied multiple times (renames copies "Labor BOE X of N), then a "template table" is copied/pasted to each new sheet multiple times. There are array formulas in the first row of this "template table" and in column A I have a "Insert_Rows" helper number. The code loops through column A, inserts rows based on "Insert_Rows" number, then drags the array formulas down that many rows.
Unfortunately, I am trying to use a "cheap workaround" to fix the cell reference in my array formulas - because I need certain cell references locked on "1 cell above where the array formula" (see bolded/underlined cell references in array formulas at bottom of post). I am doing this to extract a unique list of resources.
Any thoughts on how to improve this operation?
Initial code to copy template, insert template tables, and populate information by dragging array formulas down.
Here is the next function that I am using to fix the array formulas
Column C - Replace "Adr_Res"
Column F - Replace "Adr_F" (...same formulas in F-R, except column reference)
Unfortunately, I am trying to use a "cheap workaround" to fix the cell reference in my array formulas - because I need certain cell references locked on "1 cell above where the array formula" (see bolded/underlined cell references in array formulas at bottom of post). I am doing this to extract a unique list of resources.
Any thoughts on how to improve this operation?
Initial code to copy template, insert template tables, and populate information by dragging array formulas down.
Code:
Sub Copy_BOE_Template()
'STEP 1: DEFINE VARIABLES
'Function 1:
Dim Sh As Worksheet
Dim Template_BOE As Worksheet
Dim Num_BOEs As Integer
Dim Num_Sheets As Integer
Dim Num_Years As Integer
Dim X As Integer
'Function 2:
Dim Source_End_Row As Integer
Dim Insert_Rows As Integer
Dim N As Long
'Function 3:
Dim Source_Start_Row As Integer
'Function 4:
Dim Source_End_Row_2 As Integer
Dim Insert_Rows_2 As Integer
Dim N2 As Integer
'--------------------------------------------------------------------------
'STEP 2: COPY "TEMPLATE - BOES" & RENAME WORKSHEETS
Set Template_BOE = Worksheets("Template - BOEs")
Num_BOEs = Worksheets("Staffing Plan").Range("D10")
Template_BOE.Name = "Template - BOEs"
Num_Sheets = ActiveWorkbook.Worksheets.Count
For X = 1 To Num_BOEs
Template_BOE.Copy After:=Sheets(Num_Sheets + X - 1)
Sheets(X + Num_Sheets).Name = "Labor BOE " & X & " of " & Num_BOEs
'Paste the sequential BOE Number in cell A1
Sheets(X + Num_Sheets).Range("A1").Value = X
Next X
'----------------------------------------------------------------------------------------
For Each Sh In ActiveWorkbook.Sheets
If Left(Sh.Name, 9) = "Labor BOE" Then
'Paste values for general information
With Sh.Range("A1:U11")
.Value = .Value
End With
'Populate the "Labor Hours By Resource" summary
Source_End_Row = Sh.Range("T" & Rows.Count).End(xlUp).Row
For N = Source_End_Row To 3 Step -1
Insert_Rows = Sh.Cells(N, "A").Value
If Insert_Rows > 0 Then
Sh.Range("A" & N + 1 & ":A" & N + Insert_Rows).EntireRow.Insert
Sh.Range("A" & N & ":U" & N).Copy Destination:=Sh.Range("A" & N + 1 & ":U" & N + Insert_Rows)
'Clear the "insert rows" number in column A
With Sh.Range("A" & N & ":A" & N + Insert_Rows + 2)
.ClearContents
End With
End If
Next N
'------------------------------------------------------------------------------------
'Insert Annual Labor hour summary based on the number of years required
Num_Years = Sh.Range("U1").Value
Source_Start_Row = Sh.Range("T" & Rows.Count).End(xlUp).Row + 1
For b = 1 To Num_Years
Sheets("Template - Tasks").Range("A20:U25").Copy Destination:=Sh.Range("A" & Source_Start_Row)
Next
'------------------------------------------------------------------------------------
'Populate the "Monthly Labor Hours Summary"
Source_End_Row_2 = Sh.Range("T" & Rows.Count).End(xlUp).Row
For N2 = Source_End_Row_2 To 3 Step -1
Insert_Rows_2 = Sh.Cells(N2, "A").Value
If Insert_Rows_2 > 0 Then
Sh.Range("A" & N2 + 1 & ":A" & N2 + Insert_Rows_2).EntireRow.Insert
Sh.Range("A" & N2 & ":U" & N2).Copy Destination:=Sh.Range("A" & N2 + 1 & ":U" & N2 + Insert_Rows_2)
'Clear the "insert rows" number in column A
With Sh.Range("A" & N2 & ":A" & N2 + Insert_Rows + 2)
.ClearContents
End With
End If
Next N2
End If
Next Sh
End SubHere is the next function that I am using to fix the array formulas
Code:
Sub Replace_Res_Refs()
'STEP 1: Define variables
Dim Sh As Worksheet
Dim c As Range
Dim Adr_Date As String
Dim Adr_Res As String
Dim Adr_F As String
Dim Adr_G As String
Dim Adr_H As String
Dim Adr_I As String
Dim Adr_J As String
Dim Adr_K As String
Dim Adr_L As String
Dim Adr_M As String
Dim Adr_N As String
Dim Adr_O As String
Dim Adr_P As String
Dim Adr_Q As String
'STEP 2: Identify cell reference to replace
Adr_Date = "F16"
Adr_Res = "$C$14"
Adr_F = "F$21"
Adr_G = "G$21"
Adr_H = "H$21"
Adr_I = "I$21"
Adr_J = "J$21"
Adr_K = "K$21"
Adr_L = "L$21"
Adr_M = "M$21"
Adr_N = "N$21"
Adr_O = "O$21"
Adr_P = "P$21"
Adr_Q = "Q$21"
'STEP 3: Turn on manual calculations (done for speed)
Application.Calculation = xlCalculationManual
'STEP 4: Replace "stuck" absolute reference
On Error Resume Next
For Each Sh In Worksheets
If Sh.Name Like "Labor BOE*" Then
'COLUMN F
On Error Resume Next
For Each c In Sh.Range("F:F").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_Date) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_Date, "$F$18")
End If
Next c
On Error GoTo 0
'COLUMN C
On Error Resume Next
For Each c In Sh.Range("C:C").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_Res) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_Res, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN F
On Error Resume Next
For Each c In Sh.Range("F:F").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_F) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_F, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN G
On Error Resume Next
For Each c In Sh.Range("G:G").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_G) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_G, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN H
On Error Resume Next
For Each c In Sh.Range("H:H").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_H) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_H, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN I
On Error Resume Next
For Each c In Sh.Range("I:I").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_I) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_I, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN J
On Error Resume Next
For Each c In Sh.Range("J:J").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_J) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_J, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN K
On Error Resume Next
For Each c In Sh.Range("K:K").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_K) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_K, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN L
On Error Resume Next
For Each c In Sh.Range("L:L").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_L) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_L, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN M
On Error Resume Next
For Each c In Sh.Range("M:M").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_M) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_M, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN N
On Error Resume Next
For Each c In Sh.Range("N:N").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_N) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_N, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN O
On Error Resume Next
For Each c In Sh.Range("O:O").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_O) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_O, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN P
On Error Resume Next
For Each c In Sh.Range("P:P").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_P) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_P, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
'COLUMN Q
On Error Resume Next
For Each c In Sh.Range("Q:Q").SpecialCells(xlCellTypeFormulas)
If InStr(c.FormulaArray, Adr_Q) > 0 Then
c.FormulaArray = Replace(c.FormulaArray, Adr_Q, c.Offset(-1, 0).Address(1, 1))
End If
Next c
On Error GoTo 0
End If
Next Sh
On Error GoTo 0
'STEP 5: Revert back to Automatic calculations (done for speed)
Application.Calculation = xlCalculationAutomatic
End SubColumn C - Replace "Adr_Res"
Code:
{=IFERROR(INDEX('Staffing Plan'!$K$14:$K$1008, MATCH(0, IF($A$1='Staffing Plan'!$W$14:$W$1008, COUNTIF([U][B]$C$21:[/B][/U]$C21, 'Staffing Plan'!$K$14:$K$1008), ""), 0)),"")}Column F - Replace "Adr_F" (...same formulas in F-R, except column reference)
Code:
{=SUM(IF('Staffing Plan'!$W$13:$W$1008=$A$1,IF('Staffing Plan'!$K$13:$K$1008=$C22,IF('Staffing Plan'!$K$13:$FY$13=[U][B]F$21[/B][/U],'Staffing Plan'!$K$13:$FY$1008))))}
Last edited:
