Compiling dynamic Excel formulas to static references

''Compiling' function from http://iluvspreadsheets.wordpress.com/
'Formula parser taken from https://fastexcel.wordpress.com/2013/10/27/parsing-functions-from-excel-formulas-using-vba-is-mid-or-a-byte-array-the-best-method/

Option Explicit
Option Base 0
Option Compare Binary

'"Compile" all dynamic formulas in the active workbook, so as to make a more static version of your spreadsheet with increased transparency.
'Specifically, INDEX/INDIRECT formulas are converted into their evaluated cell references
'Also converts ranges like $13:$13 into their evaluation from the current cell, i.e. to F13 for cell F21.
Sub CompileReferences()
Dim strFunc$, abFormula() As Byte, chars() As Byte, jStart&, jEnd&, c As Range, sheet, frm$, lFrom&, lTo&, lOpen&, sFnc$, rslt, sRslt$, sPars$, sEvRef$, rRef As Range, sLeft$, matches, match, r As Range
chars = "+-,/*(=><& :!^" & vbLf
speedUp

'Set sheet = ActiveSheet
For Each sheet In ActiveWorkbook.Sheets
    sheet.Select
    sheet.Activate
    On Error GoTo nextSheet:
    For Each c In sheet.UsedRange.SpecialCells(xlCellTypeFormulas, 23)
        On Error GoTo 0
'Set c = ActiveCell
        If CStr(c.Value) = "Error 2015" Then GoTo nextCell
        frm = c.Formula 'R1C1
        abFormula = frm
        sLeft = frm
        jStart = 0
        jEnd = 0
        lFrom = 0
        Do
            strFunc = GetFunc3(abFormula, chars, jStart, jEnd)
            If LenB(strFunc) = 0 Then Exit Do
            jStart = jEnd
            lFrom = WorksheetFunction.Find(strFunc, frm, lFrom + 1)
            lOpen = WorksheetFunction.Find("(", frm, lFrom + 1) + 1
            lTo = lFrom

            Do
                lTo = WorksheetFunction.Find(")", frm, lTo + 1)   'FindB
                sFnc = mid$(frm, lFrom, lTo - lFrom + 1)
                rslt = Evaluate(sFnc)
                sRslt = ""
                On Error Resume Next
                If Not IsArray(rslt) Then sRslt = CStr(rslt)
                On Error GoTo 0
                If TypeName(rslt) <> "Error" Or sRslt <> "Error 2015" Then
                    sPars = mid$(frm, lOpen, lTo - lOpen)
                    sEvRef = ""
                    'Replace specific formulas with their evaluated references
                    If strFunc = "INDIRECT" Then
                        sEvRef = Evaluate(sPars)
                        c.Formula = Replace(c.Formula, sFnc, sEvRef, 1, 1)
                    ElseIf strFunc = "COLUMNS" Then
                        If sRslt = c.Column Then c.Formula = Replace(c.Formula, sFnc, "COLUMN()", 1, 1)
                    ElseIf strFunc = "ROWS" Then
                        If sRslt = c.row Then c.Formula = Replace(c.Formula, sFnc, "ROW()", 1, 1)
                    ElseIf strFunc = "INDEX" Then
                        Set rRef = Evaluate(sFnc)
                        sEvRef = IIf(rRef.Worksheet.Index = sheet.Index, "", "'" & rRef.Worksheet.name & "'!") & rRef.Address
                        c.Formula = Replace(c.Formula, sFnc, sEvRef, 1, 1)
                    'Else
                    End If
                    sLeft = Replace(sLeft, sFnc, sEvRef, 1, 1)
                    GoTo skip
                End If
            Loop
skip:
        Loop
        'Also replace multi-cell references with exact references
        '//How to get all multi-cell references? iterate through c.Precedents.Areas?
        'Filter out references within functions
        'Functions already filtered out
        'and can also filter out strings...
        sLeft = regReplace("""(("""")|([^""]))+""", sLeft)
        'then match for multi-cell refs (just ignore any potential sheet prefixes)
        Set matches = getMatches(sLeft, "(\$?\w+)?(\$?\d+)?\:(\$?\w+)?(\$?\d+)?")
        For Each match In matches
            Set r = Range(CStr(match))
            'How to evaluate the broad range into their exact reference? check col/row intersect
            On Error GoTo tryRow
            Set rRef = Intersect(sheet.columns(c.Column), r)
            On Error GoTo 0
            'address with sheet ref if needed
            sEvRef = IIf(rRef.Worksheet.Index = sheet.Index, "", "'" & r.Worksheet.name & "'!") & rRef.Address '(0, 0)
            c.Formula = Replace(c.Formula, CStr(match), sEvRef)
        Next
nextCell:
    Next
    On Error GoTo 0
nextSheet:
Next
slowDown
Exit Sub
tryRow:
Set rRef = Intersect(sheet.rows(c.row), r)
Resume Next
End Sub

'Does a regex replace
Public Function regReplace$(patt$, inText$, Optional withText$ = "", Optional fuzzyCase As Boolean = False)
regReplace = inText
Dim regex As New RegExp
With regex
    .MultiLine = True
    .ignorecase = fuzzyCase
    .pattern = patt
    .Global = True
    On Error Resume Next    'for no hits
    regReplace = .Replace(inText, withText)
End With
End Function

'regex matching
Function getMatches(s$, reg$, Optional warnOnError As Boolean = False, Optional fuzzyCase As Boolean = False)
Dim regex As New RegExp
regex.pattern = reg
regex.ignorecase = fuzzyCase
regex.MultiLine = True
regex.Global = True
Set getMatches = regex.execute(s)
If warnOnError And getMatches.Count < 1 Then
    Stop
End If
End Function

'speed up processing by pausing other stuff
Function speedUp()
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
End With
End Function

'undo the settings of SpeedUp
Function slowDown(Optional force As Boolean = False, Optional tally As Boolean = True)
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
End With
Cells.Calculate
End Function

'Parse a formula to identify the names of functions used
'Original source: https://fastexcel.wordpress.com/2013/10/27/parsing-functions-from-excel-formulas-using-vba-is-mid-or-a-byte-array-the-best-method/
Function GetFunc3(abFormula() As Byte, abStartChars() As Byte, jStart As Long, jEnd As Long) As String
Dim j&, k&, jj&, jStartChar&, jFirst&, blStart As Boolean, blDoubleQ As Boolean, blSingleQ As Boolean, abFunc() As Byte
jFirst = jStart + 2
blDoubleQ = False
For j = jStart + 2 To (UBound(abFormula) - 2) Step 2
    If abFormula(j + 1) = 0 Then
        If abFormula(j) = 39 Then blSingleQ = Not blSingleQ
        If Not blSingleQ Then
            If abFormula(j) = 34 Then blDoubleQ = Not blDoubleQ
            If Not blDoubleQ Then
                If abFormula(j) = 40 Then
                    blStart = False
                    For jj = j - 2 To jStart Step -2
                        For jStartChar = 0 To UBound(abStartChars) Step 2
                            If abFormula(jj) = abStartChars(jStartChar) Then
                                blStart = True
                                jFirst = jj + 2
                                Exit For
                            End If
                        Next jStartChar
                        If blStart Then Exit For
                    Next
                    If blStart Then
                        If j > jFirst Then
                            jEnd = j
                            Exit For
                        ElseIf abFormula(jFirst) = 40 Then
                            jFirst = jFirst + 2
                        End If
                    End If
                End If
            End If
        End If
    End If
Next
If blStart And jEnd > jFirst Then
    ReDim abFunc(0 To (jEnd - jFirst - 1)) As Byte
    For k = 0 To UBound(abFunc)
        abFunc(k) = abFormula(jFirst + k)
    Next k
    GetFunc3 = abFunc
End If
End Function