Formula Chain Extractor

' Formula Chain Extractor
' Extract formulas and resolve nested cell references to show calculation chains

Sub ExtractFormulaChain()
    ' Extract visible formulas from a column and resolve references
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    ' Prompt for source column
    Dim sourceCol As String
    sourceCol = InputBox("Enter the column letter to extract formulas from:", "Source Column", "A")

    If sourceCol = "" Then Exit Sub

    Dim ws As Worksheet
    Set ws = ActiveSheet

    ' Find last visible row in column
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, sourceCol).End(xlUp).Row

    ' Create collection to store extracted formulas
    Dim formulaText As String
    formulaText = "Formula Chain Export - " & Format(Now, "dd/mm/yyyy hh:mm") & vbCrLf & vbCrLf

    Dim i As Long
    For i = 1 To lastRow
        ' Check if row is visible
        If Not ws.Rows(i).Hidden Then
            Dim cellRef As String
            Dim cellValue As Variant
            Dim cellFormula As String

            cellRef = sourceCol & i
            Set cellRange = ws.Range(cellRef)

            ' Get cell value
            cellValue = cellRange.Value

            ' Check if cell has formula
            If cellRange.HasFormula Then
                cellFormula = cellRange.Formula

                ' Resolve nested formulas
                Dim resolvedFormula As String
                resolvedFormula = ResolveFormulaReferences(ws, cellFormula)

                ' Add to export text
                formulaText = formulaText & "Cell " & cellRef & ":" & vbCrLf
                formulaText = formulaText & "  Formula: " & cellFormula & vbCrLf
                formulaText = formulaText & "  Resolved: " & resolvedFormula & vbCrLf
                formulaText = formulaText & "  Result: " & cellValue & vbCrLf & vbCrLf
            Else
                ' Plain value, no formula
                formulaText = formulaText & "Cell " & cellRef & ": " & cellValue & " (value)" & vbCrLf & vbCrLf
            End If
        End If
    Next i

    Application.ScreenUpdating = True

    ' Export to text file
    Dim exportPath As String
    exportPath = ThisWorkbook.Path & "FormulaExport_" & Format(Now, "yyyymmdd_hhmmss") & ".txt"

    Dim fileNum As Integer
    fileNum = FreeFile

    Open exportPath For Output As #fileNum
    Print #fileNum, formulaText
    Close #fileNum

    MsgBox "Formula chain exported to:" & vbCrLf & exportPath, vbInformation

    ' Optionally open the file
    Shell "notepad.exe " & exportPath, vbNormalFocus

    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    If fileNum > 0 Then Close #fileNum
    MsgBox "Error extracting formulas: " & Err.Description, vbCritical
End Sub

Function ResolveFormulaReferences(ws As Worksheet, formula As String) As String
    ' Resolve cell references in formula to their actual values
    On Error Resume Next

    Dim resolvedFormula As String
    resolvedFormula = formula

    ' Find all cell references (pattern: letter(s) followed by number(s))
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = "[A-Z]{1,3}[0-9]{1,7}"

    Dim matches As Object
    Set matches = regex.Execute(formula)

    If matches.Count > 0 Then
        Dim match As Object
        For Each match In matches
            Dim cellAddress As String
            cellAddress = match.value

            ' Get value from referenced cell
            Dim refValue As Variant
            refValue = ws.Range(cellAddress).Value

            ' If referenced cell also has formula, get its value
            If ws.Range(cellAddress).HasFormula Then
                refValue = ws.Range(cellAddress).Value & " [from formula]"
            End If

            ' Replace cell reference with value in resolved formula
            resolvedFormula = Replace(resolvedFormula, cellAddress, refValue, , , vbTextCompare)
        Next match
    End If

    ' Clean up formula syntax markers
    resolvedFormula = Replace(resolvedFormula, "=", "")

    ResolveFormulaReferences = resolvedFormula
End Function

Sub ExportToWordDocument()
    ' Export formula chain to Word document with formatting
    On Error GoTo ErrorHandler

    ' Check if Word is available
    Dim wordApp As Object
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True

    Dim wordDoc As Object
    Set wordDoc = wordApp.Documents.Add

    ' Prompt for source column
    Dim sourceCol As String
    sourceCol = InputBox("Enter the column letter to extract formulas from:", "Source Column", "A")

    If sourceCol = "" Then
        wordDoc.Close SaveChanges:=False
        wordApp.Quit
        Exit Sub
    End If

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, sourceCol).End(xlUp).Row

    ' Add title
    wordDoc.Content.Text = "Formula Chain Export - " & ws.Name & vbCrLf & _
                          Format(Now, "dd/mm/yyyy hh:mm") & vbCrLf & vbCrLf

    ' Extract formulas
    Dim i As Long
    For i = 1 To lastRow
        If Not ws.Rows(i).Hidden Then
            Dim cellRef As String
            cellRef = sourceCol & i

            Dim cellRange As Range
            Set cellRange = ws.Range(cellRef)

            If cellRange.HasFormula Then
                Dim para As Object
                Set para = wordDoc.Content.Paragraphs.Add

                para.Range.Text = "Cell " & cellRef & ":" & vbCrLf & _
                                "  " & cellRange.Formula & vbCrLf & _
                                "  = " & cellRange.Value & vbCrLf & vbCrLf

                para.Range.Font.Name = "Courier New"
                para.Range.Font.Size = 10
            End If
        End If
    Next i

    MsgBox "Formula chain exported to Word document!", vbInformation

    Exit Sub

ErrorHandler:
    MsgBox "Error exporting to Word: " & Err.Description & vbCrLf & _
           "Make sure Microsoft Word is installed.", vbCritical
End Sub