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

Question

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!"

Answer 1

Keep it simple stupid
Assuming either the currently selected cell formula or a textbox input, a simple Userform might act as a formula translator into a line of VBA code:
Basic Userform code
Needed: TextBox1, TextBox2, CommandButton1
Option Explicit
Private Sub CommandButton1_Click()
'Purp: Redouble inside quotation marks
Const Quot As String = """"
Dim assignTo As String
assignTo = "ws.Range(""" & Selection.Address(False, False) & """).Formula2 = "
Me.TextBox2.Text = assignTo & Quot & Replace(Me.TextBox1.Text, Quot, String(2, Quot)) & Quot
End Sub
Private Sub UserForm_Initialize()
'Purp: assume active formula as wanted input
Me.TextBox1 = Selection.Formula2
End Sub
Private Sub UserForm_Layout()
'Purp: example layout textboxes
'a) define textboxes
Dim textboxes() As String
textboxes = Split("Textbox1,Textbox2", ",")
'b) format
Dim i As Long
For i = 0 To UBound(textboxes)
With Me.Controls(textboxes(i))
.Font.Name = "Courier New"
.Font.Size = 12
.MultiLine = True
.EnterKeyBehavior = True
End With
Next i
End Sub
Possible extensions
Of course you might add an insertion routine (inserting e.g. {} brackets) as well as some replacement procedures like in my workaround above.
Just for fun, a basic insertion routine here:
Private Sub CommandButton2_Click()
'Purp: Insert brackets {}
With Me.TextBox1
.SetFocus
If InsertAtCursor("{}", Me.TextBox1) Then
.SelStart = .SelStart - 1
End If
End With
End Sub
Public Function InsertAtCursor(s As String, ctrl As MSForms.Control, Optional ErrMsg As String) As Boolean
'Purpose: Insert the characters at the cursor in the active control.
'Site: http://allenbrowne.com/func-InsertChar.html
'Return: True if characters were inserted.
'Arguments: s = the character(s) you want inserted at the cursor.
' ErrMsg = string to append any error messages to.
'Note: Control must have focus.
On Error GoTo Err_Handler
Dim prior As String 'Text before the cursor.
Dim after As String 'Text after the cursor.
Dim cnt As Long 'Number of characters
Dim iSelStart As Long 'Where cursor is.
Dim txt As String 'text with LineFeeds only
If s <> vbNullString Then
With ctrl ' --> UserForm Control
txt = Replace(.Text, vbCrLf, vbLf) ' LineFeeds only (MultiLine)
If .Enabled And Not .Locked Then
cnt = Len(txt) ' Zählung ohne vbCr's !
'SelStart can't cope with more than 32k characters.
If cnt <= 32767& - Len(s) Then
'Remember characters before cursor.
iSelStart = .SelStart
If iSelStart > 1 Then
prior = Left$(txt, iSelStart)
End If
'Remember characters after selection.
If iSelStart + .SelLength < cnt Then
after = Mid$(txt, iSelStart + .SelLength + 1) ' OP:2
End If
'Assign prior characters, new ones, and later ones.
.value = prior & s & after
'Put the cursor back where it as, after the new ones.
.SelStart = iSelStart + Len(s)
'Return True on success
InsertAtCursor = True
End If
End If
End With
End If
Exit_Handler:
Exit Function
Err_Handler:
Debug.Print Err.Number, Err.Description
Select Case Err.Number
Case 438&, 2135&, 2144& 'Object doesn't support this property. Property is read-only. Wrong data type.
ErrMsg = ErrMsg & "You cannot insert text here." & vbCrLf
Case 2474&, 2185& 'No active control. Control doesn't have focus.
ErrMsg = ErrMsg & "Cannot determine which control to insert the characters into." & vbCrLf
Case Else
ErrMsg = ErrMsg & "Error " & Err.Number & ": " & Err.Description & vbCrLf
End Select
Resume Exit_Handler
End Function