← Back to Home
DCF Valuation in Excel with VBA

DCF Valuation in Excel with VBA

I did a simple DCF Valuation with Python and I thought I try it with Excel and VBA as well. The VBA module:

Step 1: Converting Text Values with Units

Many financial datasets store numbers as text with extra formatting—such as commas, unit abbreviations (M, B, T), or percentages. I downloaded my financial statements from stockanalysis.com and I wrote the following helper function, ParseValue, to clean and convert the data into properly formatted numeric values. For instance, “15%” becomes 0.15 and “12.5M” becomes 12,500,000, also multiplied figures by 1,000,000 since they were given in million dollars.

Option Explicit

' --- Helper Function: ParseValue ---
' Converts text values with units (e.g., "12.5M", "3.2B", "15%") into a numeric value.
Public Function ParseValue(val As Variant) As Double
    Dim s As String, lastChar As String
    s = CStr(val)
    s = Replace(s, ",", "")
    s = Trim(s)
    
    If s = "-" Or s = "" Or s = "NA" Or s = "N/A" Then
        ParseValue = 0
        Exit Function
    End If
    
    ' Handle percentages
    If InStr(s, "%") > 0 Then
        s = Replace(s, "%", "")
        If IsNumeric(s) Then
            ParseValue = CDbl(s) / 100
        Else
            ParseValue = 0
        End If
        Exit Function
    End If
    
    lastChar = Right(s, 1)
    Select Case lastChar
        Case "B"
            If IsNumeric(Left(s, Len(s) - 1)) Then
                ParseValue = CDbl(Left(s, Len(s) - 1)) * 1000000000#
            Else
                ParseValue = 0
            End If
        Case "M"
            If IsNumeric(Left(s, Len(s) - 1)) Then
                ParseValue = CDbl(Left(s, Len(s) - 1)) * 1000000#
            Else
                ParseValue = 0
            End If
        Case "T"
            If IsNumeric(Left(s, Len(s) - 1)) Then
                ParseValue = CDbl(Left(s, Len(s) - 1)) * 1000000000000#
            Else
                ParseValue = 0
            End If
        Case Else
            If IsNumeric(s) Then
                ' For plain numbers, assume the value is in millions (adjust as needed)
                ParseValue = CDbl(s) * 1000000#
            Else
                ParseValue = 0
            End If
    End Select
End Function

Step 2: Extracting Values Using Substring Matching

Financial items (such as EBIT, Depreciation, or CAPEX) may not be stored as exact text. The next helper function, GetValue, searches for a substring match in column B (starting at row 5) and returns the corresponding value from column C—after converting it with ParseValue.

' --- Helper Function: GetValue ---
' Searches for a cell in column B (starting at row 5) that contains the search string (substring match)
' and returns the numeric value from the corresponding cell in column C.
Public Function GetValue(ws As Worksheet, searchStr As String, Optional secondOccurrence As Boolean = False) As Double
    Dim lastRow As Long, r As Long, countFound As Integer
    countFound = 0
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    For r = 5 To lastRow
        Dim cellText As String
        cellText = Trim(ws.Cells(r, "B").Value)
        ' Check if searchStr appears anywhere in the cell (case-insensitive)
        If InStr(1, cellText, searchStr, vbTextCompare) > 0 Then
            countFound = countFound + 1
            If (Not secondOccurrence And countFound = 1) Or (secondOccurrence And countFound = 2) Then
                GetValue = ParseValue(ws.Cells(r, "C").Value)
                Exit Function
            End If
        End If
    Next r
    GetValue = 0
End Function

Step 3: Main DCF Calculation and Output

The main subroutine, CalculateDCF, gathers key metrics from your three financial statement sheets, performs the DCF calculations, and then outputs a summary with all assumptions, equations, and steps neatly into a “valuation” sheet.

' --- Main Subroutine: CalculateDCF ---
' Extracts key metrics from "Income Statement", "Balance Sheet", and "Cash Flow" sheets,
' forecasts Free Cash Flow to the Firm (FCFF), calculates WACC, and computes an intrinsic share price.
' Outputs a formatted summary on a sheet named "valuation".
Public Sub CalculateDCF()
    Dim wsFin As Worksheet, wsBal As Worksheet, wsCF As Worksheet, wsVal As Worksheet
    Set wsFin = ThisWorkbook.Sheets("Income Statement")
    Set wsBal = ThisWorkbook.Sheets("Balance Sheet")
    Set wsCF = ThisWorkbook.Sheets("Cash Flow")
    
    ' --- Create (or clear) the "valuation" sheet ---
    On Error Resume Next
    Set wsVal = ThisWorkbook.Sheets("valuation")
    On Error GoTo 0
    If wsVal Is Nothing Then
        Set wsVal = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsVal.Name = "valuation"
    Else
        wsVal.Cells.Clear
    End If
    
    Dim iRow As Long
    iRow = 1
    wsVal.Cells(iRow, 1).Value = "DCF Valuation Summary"
    wsVal.Cells(iRow, 1).Font.Bold = True
    iRow = iRow + 2
    
    ' --- Parameters & Assumptions ---
    Dim tax As Double, DEFAULT_GROWTH As Double, TERM_GROWTH As Double, DEFAULT_COST_DEBT As Double
    Dim FORECAST_YEARS As Integer
    tax = 0.21                  ' Default effective tax rate (T)
    DEFAULT_GROWTH = 0.15       ' Annual FCFF growth rate (g)
    TERM_GROWTH = 0.04          ' Terminal growth rate (g_term)
    DEFAULT_COST_DEBT = 0.04    ' Cost of debt (r_d)
    FORECAST_YEARS = 5          ' Forecast period (years)
    
    wsVal.Cells(iRow, 1).Value = "Assumptions:"
    wsVal.Cells(iRow, 1).Font.Underline = xlUnderlineStyleSingle
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Effective Tax Rate (T): " & Format(tax, "0.00%")
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Default Growth Rate (g): " & Format(DEFAULT_GROWTH, "0.00%")
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Terminal Growth Rate (g_term): " & Format(TERM_GROWTH, "0.00%")
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Default Cost of Debt (r_d): " & Format(DEFAULT_COST_DEBT, "0.00%")
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Forecast Period: " & FORECAST_YEARS & " years"
    iRow = iRow + 2
    
    ' --- Extract Key Metrics ---
    Dim EBIT As Double, depr As Double, capex As Double, FCFF0 As Double
    EBIT = GetValue(wsFin, "EBIT")  ' Searches column B for "EBIT"; gets value from column C
    depr = GetValue(wsCF, "Depreciation")
    capex = Abs(GetValue(wsCF, "Capital Expenditure"))
    
    wsVal.Cells(iRow, 1).Value = "Extracted Metrics:"
    wsVal.Cells(iRow, 1).Font.Underline = xlUnderlineStyleSingle
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "EBIT: " & EBIT
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Depreciation: " & depr
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "CAPEX: " & capex
    iRow = iRow + 1
    
    Dim wcCurrent As Double, wcPrev As Double, deltaWC As Double
    wcCurrent = GetValue(wsBal, "Working Capital")
    wcPrev = GetValue(wsBal, "Working Capital", True) ' Second occurrence for previous period
    deltaWC = wcCurrent - wcPrev
    wsVal.Cells(iRow, 1).Value = "Working Capital (Current): " & wcCurrent
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Working Capital (Previous): " & wcPrev
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Δ Working Capital: " & deltaWC
    iRow = iRow + 2
    
    ' --- FCFF Calculation ---
    ' Equation: FCFF = EBIT * (1 - T) + Depreciation - CAPEX - ΔWC
    FCFF0 = GetValue(wsCF, "Free Cash Flow")
    If FCFF0 = 0 Then
        FCFF0 = EBIT * (1 - tax) + depr - capex - deltaWC
        wsVal.Cells(iRow, 1).Value = "Calculated FCFF = EBIT*(1-T) + Depreciation - CAPEX - ΔWC: " & FCFF0
    Else
        wsVal.Cells(iRow, 1).Value = "Extracted FCFF: " & FCFF0
    End If
    iRow = iRow + 2
    
    ' --- Net Debt ---
    Dim netDebt As Double
    netDebt = GetValue(wsBal, "Net Cash (Debt)")
    If netDebt = 0 Then
        Dim totalDebt As Double, cashEquiv As Double
        totalDebt = GetValue(wsBal, "Total Debt")
        cashEquiv = GetValue(wsBal, "Cash & Equivalents")
        netDebt = totalDebt - cashEquiv
    End If
    wsVal.Cells(iRow, 1).Value = "Net Debt: " & netDebt
    iRow = iRow + 2
    
    ' --- Forecast FCFF ---
    Dim forecast() As Double
    ReDim forecast(1 To FORECAST_YEARS)
    wsVal.Cells(iRow, 1).Value = "Forecasted FCFF (for each year):"
    wsVal.Cells(iRow, 1).Font.Underline = xlUnderlineStyleSingle
    iRow = iRow + 1
    Dim j As Integer
    For j = 1 To FORECAST_YEARS
        forecast(j) = FCFF0 * (1 + DEFAULT_GROWTH) ^ j
        wsVal.Cells(iRow, 1).Value = "Year " & j & ": " & forecast(j)
        iRow = iRow + 1
    Next j
    iRow = iRow + 1
    
    ' --- WACC Calculation ---
    Dim rf As Double, beta As Double, mrp As Double, ce As Double, de As Double
    Dim we As Double, wd As Double, WACC As Double
    rf = 0.022         ' Risk-free rate (e.g., TLT yield)
    beta = 1           ' Assumed beta (adjust as needed)
    mrp = 0.06         ' Assumed market risk premium
    ce = rf + beta * mrp   ' Cost of Equity
    de = DEFAULT_COST_DEBT ' Cost of Debt
    we = 0.8           ' Equity weight
    wd = 0.2           ' Debt weight
    WACC = we * ce + wd * de * (1 - tax)
    
    wsVal.Cells(iRow, 1).Value = "WACC Calculation:"
    wsVal.Cells(iRow, 1).Font.Underline = xlUnderlineStyleSingle
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Risk-free Rate (r_f): " & rf
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Beta: " & beta
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Market Risk Premium (r_m - r_f): " & mrp
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Cost of Equity (r_e): " & ce
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Cost of Debt (r_d): " & de
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Equity Weight (w_e): " & we
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Debt Weight (w_d): " & wd
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "WACC: " & WACC
    iRow = iRow + 2
    
    ' --- Terminal Value and DCF Calculation ---
    Dim sumDCF As Double, termVal As Double, EV As Double
    sumDCF = 0
    For j = 1 To FORECAST_YEARS
        sumDCF = sumDCF + forecast(j) / ((1 + WACC) ^ j)
    Next j
    
    termVal = forecast(FORECAST_YEARS) * (1 + TERM_GROWTH) / (WACC - TERM_GROWTH)
    EV = sumDCF + termVal / ((1 + WACC) ^ FORECAST_YEARS)
    
    wsVal.Cells(iRow, 1).Value = "Terminal Value and DCF Calculation:"
    wsVal.Cells(iRow, 1).Font.Underline = xlUnderlineStyleSingle
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Sum of Discounted FCFF: " & sumDCF
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Terminal Value: " & termVal
    iRow = iRow + 1
    wsVal.Cells(iRow, 1).Value = "Enterprise Value (EV): " & EV
    iRow = iRow + 1
    Dim eqValue As Double
    eqValue = EV - netDebt
    wsVal.Cells(iRow, 1).Value = "Equity Value (EV - Net Debt): " & eqValue
    iRow = iRow + 2
    
    ' --- Intrinsic Share Price ---
    Dim shares As Double, intrinsicPrice As Double
    shares = 17000000000# ' Adjust to actual shares outstanding
    If shares <> 0 Then
        intrinsicPrice = eqValue / shares
    Else
        intrinsicPrice = 0
    End If
    wsVal.Cells(iRow, 1).Value = "Intrinsic Share Price: " & intrinsicPrice
    
    wsVal.Columns("A:A").EntireColumn.AutoFit
    MsgBox "DCF Valuation summary has been output to the 'valuation' sheet.", vbInformation
End Sub

This VBA module calculates the DCF valuation based on your financial statements and creates a clean, well-formatted report on a dedicated “valuation” sheet. Each section of the report shows the assumptions, equations used, and intermediate values calculated during the process. You can adjust search strings, column references, and parameters as needed to match your specific data.