Clear Constants in a range without clearing references and formulas - vba

Question

I am trying to clear all the number constants in a range of cells without clearing any formulas or cell references. Clearing the constants from cells without any formulas or cell references is simple but I am having trouble doing it when those are present. Below is the code I have so far.
Range("B2:B11").Select
Selection.SpecialCells(xlCellTypeConstants, 1).Select
Selection.ClearContents
In this range cells B5 and B7 have formulas with cell references as follows:
B5: =(G83*H1)+1181.05
B7: =E33+1292.76
The cell references will also at times reference cells on other sheets in the same workbook. I need to clear the constants from these formulas while leaving the references intact.

Answer 1

This will remove constants from all formulas in current workbook based on 2 patterns:
"=Formula-[Space]-PlusSign-[Space]-Constant" (space optional)
=(G83*H1)+1181.05 or =(G83*H1) +1181.05 or =(G83*H1)+ 1181.05 becomes =(G83*H1)
=E33+1292.76 or =E33 +1292.76 or =E33+ 1292.76 or =E33 + 1292.76 becomes =E33
"=Formula-[Space]-MinusSign-[Space]-Constant" (space optional)
Public Sub clearConstantsFromWorkBookFormulas()
Const PATTERNS As String = "~+*|~+ *|~ +*| ~+ *|~-*|~- *|~ -*|~ - *"
Dim pat As Variant
For Each pat In Split(PATTERNS, "|")
Cells.Replace What:=pat, _
Replacement:=vbNullString, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False
Next
End Sub
.
This is a more generic option using regEx pattern matching and arrays:
Public Sub testClear()
Dim ws As Worksheet
For Each ws In Application.ActiveWorkbook.Worksheets
removeConstantsFromFormulas ws.Range("B2:B11"), getRegEx
Next
End Sub
Public Sub removeConstantsFromFormulas(ByRef rng As Range, ByRef regEx As Object)
Dim v As Variant, r As Long, c As Long, lr As Long, lc As Long
lr = rng.Rows.Count
lc = rng.Columns.Count
If lr > 0 And lc > 0 Then
v = rng.Formula
For r = 1 To lr
For c = 1 To lc
If Left(v(r, c), 1) = "=" Then
If regEx.Test(v(r, c)) Then v(r, c) = regEx.Replace(v(r, c), vbNullString)
End If
Next
Next
rng.Formula = v
End If
End Sub
Private Function getRegEx() As Object
Set getRegEx = CreateObject("VBScript.RegExp")
getRegEx.Pattern = "[^a-zA-Z][0-9]+(\.?[0-9]+)"
getRegEx.Global = True
getRegEx.IgnoreCase = True
End Function
RegEx pattern: one or more digits, digit group not preceded by a letter, with or without a fraction part

Answer 2

This attempt should handle most examples using a Regexp.
There may be some edge cases as the discussion above points out. For the code below
=(G83*H1)+1181.05
=10+A1
=A1+10
=A1+(10)
=A1+10.0
becomes
=(G83*H1)
=+A1
=A1
=A1
=A1
I note it would also take out the ^2 in =A1^2
It clearly also won't cater for named formulae (named ranges).
Updated: Now handles cascading parentheses, ie
=A1+(27+(11-2))
becomes
=A1
Sub Format()
Dim objRegexB As Object
Dim lngCnt As Long
Dim X
X = [b2:b11].Formula
Set RegExB = CreateObject("vbscript.regexp")
With RegExB
.Pattern = "[=\+\/\*^\-](\([0-9]\d*(\.\d+)?\)|[0-9]\d*(\.\d+)?|\.\d+)"
.Global = True
For lngCnt = 1 To UBound(X)
Do While .Test(X(lngCnt, 1))
X(lngCnt, 1) = .Replace(X(lngCnt, 1), vbNullString)
Loop
Next
End With
[b2:b11].Formula = X
End Sub