Translate formula quotation marks incl. replacements into VBA-readable formulae

Translate formula quotation marks incl. replacements into VBA-readable formulae

I was inspired to write this post by the recent question of formula substitution using a constant. At the same time, the frequent problem emerged that quotation marks within a formula string should be replaced by double quotation marks in order to make them readable in VBA.

Practical use case

A practical use case is to copy a table formula directly from a SO website and "translate" it into a string-readable format.

But how is this supposed to be done with VBA means, since the direct input of such an incomplete formula string in a procedure code without manually added double quotation marks would immediately lead to an error?

Another feature would be to make replacements at certain points within a formula template, for example with a constant or even with several numerically identifiable markers.

I found a quick & dirty solution (without error handling) by analyzing a FormulaContainer procedure containing exclusively outcommented formulae as these would allow any prior direct code input. In order to distinguish them from the usual commentaries, I decided with a heavy heart to use the Rem prefix (i.e. Remark) as an alternative, which we may still be familiar with from ancient Basic times.

My intention is not to show a perfect solution, but to stimulate further solutions by demonstrating a possible way.

Question

Are there other work arounds allowing to copy tabular formulae with quotation marks directly and as possible replacement pattern into VBA procedures?

///////////////////////////////////

Main function QuickFormula()

References a FormulaContainer procedure containing exclusively formulae with Rem prefixes, such as e.g.

    Sub FormulaContainer()
    Rem =....
    Rem =....
    End Sub

This allows formula inputs with quotation marks similar to tabular cell inputs; furthermore these inputs may contain string identifiers facilitating wanted replacements.

Option Explicit
'Site: https://stackoverflow.com/questions/70399681/how-many-quotes-to-put-around-a-formula-that-is-sending-an-empty-string
'Auth: https://stackoverflow.com/users/6460297/t-m

Function QuickFormula(ByVal no As Long, ParamArray repl() As Variant) As String
'Purp: - change indicated code line in FormulaContainer to code readable string and
'      - replace enumerated identifiers with given value(s)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'1) get REMark code line indicated by ordinal argument no
    QuickFormula = getCodeLine("modFormula", "FormulaContainer", no)
'2a)replace "#" identifyer(s) with constant repl value
    If Not IsArray(repl(0)) Then
        QuickFormula = Replace(QuickFormula, "{1}", "#")
        QuickFormula = Replace(QuickFormula, "#", repl(0))
        If Len(QuickFormula) = 0 Then QuickFormula = "Error NA!"
        Debug.Print no & " ~~> " & Chr(34) & QuickFormula & Chr(34)
        Exit Function
    End If
'2b)replace 1-based "{i}" identifiers by ParamArray values
    Dim i As Long
    For i = LBound(repl(0)) To UBound(repl(0))
        QuickFormula = Replace(QuickFormula, "{" & i + 1 & "}", repl(0)(i))
    Next
'3) optional display in immediate window
    Debug.Print no & " ~~> " & Chr(34) & QuickFormula & Chr(34)
End Function

Help function getCodeLine()

Gets a given code line of the indicated procedure

Function getCodeLine(ByVal ModuleName As String, ByVal ProcedureName As String, Optional ByVal no As Long = 1) As String
'Purp:  return a code line in given procedure containing "Rem "
'Note:  assumes no line breaks; needs a library reference to
'       "Microsoft Visual Basic for Applications Extensibility 5.3"

    Const SEARCH As String = "Rem =", QUOT As String = """"
'1) set project
    Dim VBProj As Object
    Set VBProj = ThisWorkbook.VBProject
    If VBProj.Protection = vbext_pp_locked Then Exit Function ' escape locked projects
'2) set component
    Dim VBComp As Object
    Set VBComp = VBProj.VBComponents(ModuleName)
    Dim pk As vbext_ProcKind

'3) get no + 3 top code line(s)
    With VBComp.CodeModule
        'a)count procedure header lines
        Dim HeaderCount As Long:  HeaderCount = .ProcBodyLine(ProcedureName, pk) - .ProcStartLine(ProcedureName, pk)
        'b) get procedure code
        Dim codelines
        'codelines = Split(.Lines(.ProcBodyLine(ProcedureName, pk), .ProcCountLines(ProcedureName, pk) - HeaderCount), vbNewLine)
        codelines = Split(.Lines(.ProcBodyLine(ProcedureName, pk), no + 1), vbNewLine)
        'c) filter code lines containing "Rem" entries
        codelines = Filter(codelines, SEARCH, True)
    End With

'4) return (existing) codeline no
    If no - 1 > UBound(codelines) Then Exit Function    ' check existance
    getCodeLine = Replace(Replace(codelines(no - 1), QUOT, String(2, QUOT)), "Rem =", "=")
End Function

Example call

References all three formulae in the FormulaContainer (including an example of a non-existing number):

Sub EnterFormula()
    With Sheet1.Range("X1")      ' << change to any wanted target range
        .Offset(1).Formula2 = QuickFormula(1, 6)
        .Offset(2).Formula2 = QuickFormula(2, Array(10, 20, 30))
        'two single argument inputs with same result
        .Offset(3).Formula2 = QuickFormula(3, Array(17))
        .Offset(4).Formula2 = QuickFormula(3, 17)
        'not existing formula number in Rem code container
        .Offset(5).Formula2 = QuickFormula(333, 17)
    End With
End Sub

---

Example FormulaContainer

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Purp: formula container to be adjusted to code readable strings
'Note: Insert only Formulae starting with "Rem "-prefix!
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'      #   identifies constant replacement(s)
'      {i} stands for enumerated replacements {1},{2}..{n}
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub FormulaContainer()
Rem =IF($V#>0,IF($G#>$S#,($S#-$H#)*$K#+$Y#,($G#-$H#)*$K#+$Y#),"")
Rem =A{1}*B{3}+C{2}
Rem =A{1}+100
End Sub

Example output in immediate window

    1 ~~> "=IF($V6>0,IF($G6>$S6,($S6-$H6)*$K6+$Y6,($G6-$H6)*$K6+$Y6),"""")"
    2 ~~> "=A10*B30+C20"
    3 ~~> "=A17+100"
    3 ~~> "=A17+100"
  333 ~~> "Error NA!"

from Recent Questions - Stack Overflow https://ift.tt/32iu3Ns
https://ift.tt/eA8V8J