======================================================================== AES INTERACTIVE CURRENCY MODEL — Revenue table auto-resize Paste these two pieces of code into the workbook's VBA project. PART 1 goes in the Inputs sheet module. PART 2 goes in a NEW standard module (Insert > Module). The macro rebuilds the Revenue cash-flow table to match the design life in Inputs!C7. It writes contents, number formats and borders only. It never touches the currency conditional formatting, which lives in the fixed ranges D4:D7, C14:E64 and G14:I64. Design life is held to 1-50 years so the TOTALS row always lands on or before row 64, i.e. inside the existing conditional formatting. ======================================================================== '======================== PART 1 ======================== ' Sheet module: Inputs ' (double-click "Inputs" under Microsoft Excel Objects, paste below) '======================================================== Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) ' Only react when the design life (C7) changes If Intersect(Target, Me.Range("C7")) Is Nothing Then Exit Sub Application.EnableEvents = False On Error GoTo CleanExit RebuildRevenueTable CleanExit: Application.EnableEvents = True End Sub '======================== PART 2 ======================== ' Standard module (Insert > Module). Suggested name: modRevenue '======================================================== Option Explicit Public Sub RebuildRevenueTable() Const FIRST_ROW As Long = 14 ' first data row Const BAND_LAST As Long = 64 ' last row covered by the currency conditional formatting Const MIN_YEARS As Long = 1 Const MAX_YEARS As Long = 50 ' keeps the TOTALS row on/before row 64 Dim wsIn As Worksheet, wsRev As Worksheet Dim n As Long, i As Long, r As Long Dim lastRow As Long, totRow As Long Dim moneyFmt As String Dim prevEvents As Boolean, prevCalc As XlCalculation Set wsIn = ThisWorkbook.Worksheets("Inputs") Set wsRev = ThisWorkbook.Worksheets("Revenue") ' --- read and validate the design life --- If Not IsNumeric(wsIn.Range("C7").Value) Then Exit Sub n = Int(wsIn.Range("C7").Value) If n < MIN_YEARS Then n = MIN_YEARS If n > MAX_YEARS Then MsgBox "Design life is held to " & MAX_YEARS & " years so the table stays inside the " & _ "currency conditional formatting (rows 14-" & BAND_LAST & ")." & vbCrLf & vbCrLf & _ "Setting the design life to " & MAX_YEARS & ".", vbInformation, "Revenue table" n = MAX_YEARS End If lastRow = FIRST_ROW + n - 1 totRow = lastRow + 1 moneyFmt = """" & Chr(163) & """#,##0;[Red](""" & Chr(163) & """#,##0);\-" ' base GBP; CF overrides the symbol ' --- environment --- prevEvents = Application.EnableEvents prevCalc = Application.Calculation Application.EnableEvents = False Application.ScreenUpdating = False Application.Calculation = xlCalculationManual On Error GoTo CleanUp ' keep C7 and the table in step if the value was clamped If wsIn.Range("C7").Value <> n Then wsIn.Range("C7").Value = n ' --- clear the working band: CONTENTS, borders and bold only (NOT conditional formatting) --- With wsRev.Range("B" & FIRST_ROW & ":I" & BAND_LAST) .ClearContents .Borders.LineStyle = xlNone .Font.Bold = False End With ' --- write the data rows --- For i = 0 To n - 1 r = FIRST_ROW + i If i = 0 Then wsRev.Cells(r, "B").Value = 1 wsRev.Cells(r, "H").Formula = "=E" & r wsRev.Cells(r, "I").Formula = "=E" & r & "-$D$7" Else wsRev.Cells(r, "B").Formula = "=B" & (r - 1) & "+1" wsRev.Cells(r, "H").Formula = "=H" & (r - 1) & "+E" & r wsRev.Cells(r, "I").Formula = "=I" & (r - 1) & "+E" & r End If wsRev.Cells(r, "C").Formula = "=$D$4" wsRev.Cells(r, "D").Formula = "=$D$5" wsRev.Cells(r, "E").Formula = "=C" & r & "-D" & r wsRev.Cells(r, "F").Formula = "=1/(1+Inputs!$C$8)^B" & r wsRev.Cells(r, "G").Formula = "=E" & r & "*F" & r wsRev.Cells(r, "B").NumberFormat = "0" wsRev.Cells(r, "F").NumberFormat = "0.000" ApplyMoneyFormat wsRev, r, moneyFmt DrawDataRow wsRev, r, (i = 0) Next i ' --- TOTALS row --- wsRev.Cells(totRow, "B").Value = "TOTALS" wsRev.Cells(totRow, "C").Formula = "=SUM(C" & FIRST_ROW & ":C" & lastRow & ")" wsRev.Cells(totRow, "D").Formula = "=SUM(D" & FIRST_ROW & ":D" & lastRow & ")" wsRev.Cells(totRow, "E").Formula = "=SUM(E" & FIRST_ROW & ":E" & lastRow & ")" wsRev.Cells(totRow, "G").Formula = "=SUM(G" & FIRST_ROW & ":G" & lastRow & ")" ApplyMoneyFormat wsRev, totRow, moneyFmt DrawTotalsRow wsRev, totRow ' --- keep the "becomes profitable" indicator in step with the table --- wsRev.Range("D9").Formula = _ "=IF(MAX(I" & FIRST_ROW & ":I" & lastRow & ")<0,""Not within design life""," & _ "COUNTIF(I" & FIRST_ROW & ":I" & lastRow & ",""<0"")+1)" CleanUp: Application.Calculation = prevCalc Application.ScreenUpdating = True Application.EnableEvents = prevEvents End Sub ' Applies the currency number format to the money columns (C,D,E,G,H,I). Private Sub ApplyMoneyFormat(ws As Worksheet, r As Long, fmt As String) Dim col As Variant For Each col In Array("C", "D", "E", "G", "H", "I") ws.Cells(r, col).NumberFormat = fmt Next col End Sub ' Border scheme for a data row: medium outer edges, thin interior ' verticals, hairline bottom; the first data row also gets a medium top. Private Sub DrawDataRow(ws As Worksheet, r As Long, isFirst As Boolean) Dim c As Long For c = 2 To 9 ' columns B..I With ws.Cells(r, c) .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeLeft).Weight = IIf(c = 2, xlMedium, xlThin) .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeRight).Weight = IIf(c = 9, xlMedium, xlThin) .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeBottom).Weight = xlHairline If isFirst Then .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeTop).Weight = xlMedium End If End With Next c End Sub ' Border scheme for the TOTALS row: bold, medium top and bottom. Private Sub DrawTotalsRow(ws As Worksheet, r As Long) Dim c As Long For c = 2 To 9 With ws.Cells(r, c) .Font.Bold = True .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeLeft).Weight = IIf(c = 2, xlMedium, xlThin) .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeRight).Weight = IIf(c = 9, xlMedium, xlThin) .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeTop).Weight = xlMedium .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeBottom).Weight = xlMedium End With Next c End Sub