Clear Constants in a range without clearing references and formulas

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