Remove functions from your formulas

December 9, 2008 by JP ·

In Remove ROUND From Formulas, John Mansfield posts some code for removing the ROUND function from formulas on a worksheet. However the code has a few drawbacks:

Range is hardcoded into VBA
Assumes ROUND function is the outermost function

So I went ahead and wrote a subroutine which does the same thing without making those assumptions. I've also converted it to a single-purpose function which can convert ANY worksheet formula that takes two parameters and removes that function from the formula. The first parameter has to be a cell reference or value.

Here's the first sub. First we ask for input from the user. Application.InputBox with a Type argument of 8 allows the end user to select a range using the mouse. After locating the position of the word "ROUND" in the formula, the first parameter (the cell reference or value) is extracted.

Sub Remove_Round_Function()
' function to remove ROUND() from an existing cell a function that takes two arguments

Dim rng As Excel.Range
Dim cell As Excel.Range
Dim lRoundPos As Long
Dim lCommaPos As Long
Dim lEndParenPos As Long

' create range object consisting of only formula cells,
' based on user input
Set rng = Application.InputBox("Select the range you want to edit", , , , , , ,  Set rng = rng.SpecialCells(xlCellTypeFormulas)

For Each cell In rng
  If InStr(cell.Formula, "ROUND") > 0 Then
  ' store the position of the word "ROUND" in the given formula
    lRoundPos = InStr(cell.Formula, "ROUND")
    lCommaPos = InStr(lRoundPos + 1, cell.Formula, ",")
    lEndParenPos = InStr(lCommaPos + 1, cell.Formula, ")")
    ' recalculate formula based on position of function name
    cell.Formula = Left$(cell.Formula, lRoundPos - 1) & Mid$(cell.Formula, lRoundPos + 6, lCommaPos - (lRoundPos + 6)) & Right$(cell.Formula, Len(cell.Formula) - lEndParenPos)
  End If
Next cell

ExitProc:
Set rng = Nothing
End Sub

Let's examine the expression that creates the formula.

First we take the leftmost characters from the cell, all the way up to the position of the word ROUND.

Left$(cell.Formula, lRoundPos - 1)

This part returns everything to the left of the ROUND function. If ROUND is the outermost function, it returns the equal sign "=".

The next part is where the ROUND function is, so we extract the value or cell reference in the formula by doing some counting from various positions in the formula.

Mid$(cell.Formula, lRoundPos + 6, lCommaPos - (lRoundPos + 6))

lRoundPos + 6 represents the first character of the first argument of ROUND, so that's where we want the MID function to start. The MID function should end where the comma begins — the position of the comma minus the position of the first character equals the number of characters that should be extracted (i.e. the cell reference or value of the ROUND function).

Finally, we need to add in anything to the right of the ROUND function.

Right$(cell.Formula, Len(cell.Formula) - lEndParenPos)

The RIGHT function will extract anything to the right of the ROUND function, if there's anything left (no pun intended). If the position of the closing parenthesis for the ROUND function is the same as the length of the string, then there's nothing else to extract, and this part of the formula won't return anything. Otherwise, it will return the remaining characters to the right of the function.

Some sample output:

Before: =ROUND(A1,1)
After: =A1

Before: =LEFT(D3,2)&ROUND(A3,1)
After: =LEFT(D3,2)&A3

Before: =ROUND(A4,1)+5
After: =A4+5

Before: =LEFT(D3,1)&ROUND(A5,1)&(12+4)
After: =LEFT(D3,1)&A5&(12+4)

If your ROUND function is wrapped in parentheses, the end result will remain harmlessly wrapped in those same parentheses. This won't affect the outcome of the formula.

Here's the second, more generic sub. It is essentially the same as the sub above, but takes two parameters:

The name of the function you want to remove from the formula, and
the range on which you want to perform this action.

Sub Remove_Cell_Function(strName As String, rngRange As String)
' function to remove from an existing cell a function that takes two arguments
' the first argument has to be a cell reference or value you want to preserve
' ex: LEFT(A1,1), MAX(A1,0), etc
Dim rng As Excel.Range
Dim cell As Excel.Range
Dim lFuncPos As Long
Dim lFuncLen As Long
Dim lCommaPos As Long
Dim lEndParenPos As Long

' create range object consisting of only formula cells
On Error Resume Next
Set rng = Range(rngRange)
On Error GoTo 0

If rng Is Nothing Then GoTo ExitProc

Set rng = rng.SpecialCells(xlCellTypeFormulas)

For Each cell In rng
  If InStr(cell.Formula, UCase$(strName)) > 0 Then
    ' store the position of the function name in the given formula
    lFuncLen = Len(strName)
    lFuncPos = InStr(cell.Formula, UCase$(strName))
    lCommaPos = InStr(lFuncPos + 1, cell.Formula, ",")
    lEndParenPos = InStr(lCommaPos + 1, cell.Formula, ")")
    ' recalculate formula based on position of function name
    cell.Formula = Left$(cell.Formula, lFuncPos - 1) & Mid$(cell.Formula, lFuncPos + lFuncLen + 1, lCommaPos - (lFuncPos + lFuncLen + 1)) & Right$(cell.Formula, Len(cell.Formula) - lEndParenPos)
  End If
Next cell

ExitProc:
Set rng = Nothing
End Sub

You would call the sub as follows:

Sub testm()

Call Remove_Cell_Function("LEFT", "E12:E19")

End Sub

Make sure you backup your workbook before testing out the sub, I've done some limited testing but can't possibly forsee every condition. Remember this will only work with Excel functions that take two parameters, with the first parameter being the cell reference or value you want to preserve. For example, functions like LEFT, RIGHT, MAX, MOD, ROUND, CEILING, DOLLAR, etc.

As an example, when I call Remove_Cell_Function("MAX", "E11") and cell E11 contains:

=MAX(LEN("ABCDEFGHIJKLMNOPQRSTUVWXYZ"),100)

The end result is:

=LEN("ABCDEFGHIJKLMNOPQRSTUVWXYZ")

You'll notice that I changed the code so that it doesn't ask the user for input. That's so we can use the code in VBA without having to pause, if we got the range reference from somewhere else and just wanted to perform the function update on the worksheet. You could easily change it back (or if someone requests it, I'll just post the mod). You could also convert the argument to a Range Object (Sub Remove_Cell_Function(strName As String, rngRange As Excel.Range) if you wanted to pass a range object to it, instead of a string literal with a range address.

I'd be interested to see if anyone out there tests these functions and finds any errors caused by the code.

February 4, 2010 -- ShipTrack 4.1.2 update available
May 29, 2008 -- Open Any Email Attachment From Outlook
August 21, 2009 -- Useful toolbar buttons you don't see every day in Excel 2003, Part 1

Filed Under: Excel, VBA ·

Tagged With: Round function

About JP

I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space to learn more about VBA. Keep Reading »

Share This Article:

5 Comments:

Peder Schmedling writes:

December 10, 2008 at 2:59 am

Hi Jimmy,
First: yes, there is someone out here

Great post! I've tested the code and can confirm that it runs in Excel 2003 (Norwegian installation).

At first I was suspicious as to if this would actually work correct on a Norwegian install due to the fact that we use ";" instead of "," as separator in Excel formulas. But it turns out that this is not a problem as the formulas are "translated". When using the Forumla property of the Range object the string returned actually uses "," as separator in formulas

I did discover some bugs (for both versions of the code): when selecting just one cell (or passing a string literal with address to just one cell), the SpecialCells method would return a range object with reference to all formula cells in the active worksheet..

Also, if the user hits cancel in the Inputbox (the first version of the code) this results in an error.

You will also receive an error if you select just cells without formulas, the SpecialCells method then fails.

Here's my attempt to fix these bugs:

Sub Remove_Round_Function()
    ' function to remove ROUND() from an existing cell a function that takes
    ' two arguments
    Dim rng As Excel.Range
    Dim rngIn As Excel.Range
    Dim rngCell As Excel.Range
    Dim lngRoundPos As Long
    Dim lngCommaPos As Long
    Dim lngEndParenPos As Long
    'Get user input
    On Error Resume Next
    Set rngIn = Application.InputBox( _
        Prompt:="Select the range you want to edit", _
        Type:=8)
    On Error GoTo 0
    'Use input
    If rngIn.Cells.Count = 1 Then
        'Just one cell selected, check if it has a formula
        If rngIn.HasFormula Then
            'The cell has a formula, use the cell
            Set rng = rngIn
        End If
    Else
        'Several cells, get the formula cells
        On Error Resume Next
        Set rng = rngIn.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0
    End If
    'Validate rng object
    If rng Is Nothing Then
        'No cell(s) selected OR no cell(s) with formulas, abort
        GoTo ExitProc:
    End If
    'Loop through all cells in the range
    For Each rngCell In rng
        With rngCell
            If InStr(.Formula, "ROUND") > 0 Then
                ' store the position of the word "ROUND" in the given formula
                lngRoundPos = InStr(.Formula, "ROUND")
                lngCommaPos = InStr(lngRoundPos + 1, .Formula, ",")
                lngEndParenPos = InStr(lngCommaPos + 1, .Formula, ")")
                ' recalculate formula based on position of function name
                .Formula = Left$(.Formula, lngRoundPos - 1) _
                    & Mid$(.Formula, lngRoundPos + 6, _
                        lngCommaPos - (lngRoundPos + 6)) _
                    & Right$(.Formula, Len(.Formula) - lngEndParenPos)
            End If
        End With
    Next rngCell
ExitProc:
    Set rng = Nothing
    Set rngIn = Nothing
End Sub

Please review this code and tell me what you think

best regards
Peder Schmedling

Zach writes:

December 10, 2008 at 6:13 pm

Jimmy,

Your code will not work properly if there is a comma or parenthesis in either of the arguments. E.g., [=LEFT("Hel,lo",5)], or [=LEFT("HELLO",IF(A1=1,3,4))].
JP writes:

December 10, 2008 at 7:09 pm

Peder — nice job. Looks like I need to brush up on my defensive programming skills. You could test rngIn directly right after requesting it. It should equal Nothing if the user doesn't select a range.

But I don't see how your code fixes the problem with SpecialCells referencing all the formula cells on the worksheet if only one cell is passed as a reference. All you did was add a few checks to count the number of cells and check if the single cell has a formula; otherwise it's exactly the same code.

Zach — you're right. But do you think it's that common to write formulas like that? I don't think it's worth recoding the sub just to compensate for those few cases.

Peder Schmedling writes:

December 11, 2008 at 1:54 am

Zach,
You will always run into issues like this when parsing strings in this way. If one want's to be completely safe regular expression is probably the best way to go..

Jimmy,
My code doesn't work as intended. The code didn't actually handle the case where the user selects cancel. The code crashed when checking the Count property of the Cells property of rngIn when it was Nothing. I had to check for rngIn being nothing after the Inputbox (see code in bottom of the post).

Now for the SpecialCells method; If you look at the code you'll see that the SpecialCells method will only be called if more than one cell was selected.. If just one cell is selected I check if the cell has a formula manually. This way we won't run into the problem of SpecialCells failing when used on a single cell. Here's some code with extra comments (please tell me if something is unclear):

'Check if just one cell was selected
If rngIn.Cells.Count = 1 Then
    'Just one cell selected,
    'check if it has a formula
    If rngIn.HasFormula Then
        'This will only happen if ONE cell
        'is selected AND it has a formula
        Set rng = rngIn
    End If
Else
    'Several cells selected,
    'get the formula cells
    On Error Resume Next
    'This ensures that rng is Nothing
    'if no cells contains a formula
    Set rng = rngIn.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
End If
'Validate rng object
If rng Is Nothing Then
    'This happens if:
    ' - One cell was selected with no formula
    ' - Several cells was selected an non of
    '   them contained a formula
    GoTo ExitProc:
End If

Here is a corrected version of my code, this should handle if the user hits cancel as well:

Sub Remove_Round_Function()
    ' function to remove ROUND() from an existing cell a function that takes
    ' two arguments
    Dim rng As Excel.Range
    Dim rngIn As Excel.Range
    Dim rngCell As Excel.Range
    Dim lngRoundPos As Long
    Dim lngCommaPos As Long
    Dim lngEndParenPos As Long
    'Get user input
    On Error Resume Next
    Set rngIn = Application.InputBox( _
        Prompt:="Select the range you want to edit", _
        Type:=8)
    On Error GoTo 0
    'Validate user input
    If rngIn Is Nothing Then
        'No cell(s) selected
        GoTo ExitProc:
    End If
    'Use input
    If rngIn.Cells.Count = 1 Then
        'Just one cell selected
        If rngIn.HasFormula Then
            'The cell has a formula, use the cell
            Set rng = rngIn
        End If
    Else
        'Several cells selected
        On Error Resume Next
        'Get the formula cells (if any)
        Set rng = rngIn.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0
    End If
    'Validate rng object
    If rng Is Nothing Then
        'No cell(s) with formulas selected, abort
        GoTo ExitProc:
    End If
    'Loop through all cells in the range
    For Each rngCell In rng
        With rngCell
            If InStr(.Formula, "ROUND") > 0 Then
                ' store the position of the word "ROUND" in the given formula
                lngRoundPos = InStr(.Formula, "ROUND")
                lngCommaPos = InStr(lngRoundPos + 1, .Formula, ",")
                lngEndParenPos = InStr(lngCommaPos + 1, .Formula, ")")
                ' recalculate formula based on position of function name
                .Formula = Left$(.Formula, lngRoundPos - 1) _
                    & Mid$(.Formula, lngRoundPos + 6, _
                        lngCommaPos - (lngRoundPos + 6)) _
                    & Right$(.Formula, Len(.Formula) - lngEndParenPos)
            End If
        End With
    Next rngCell
ExitProc:
    Set rng = Nothing
    Set rngIn = Nothing
End Sub

Zach writes:

December 11, 2008 at 11:14 am

OK, I've created a function to help parse the formula for strange cases. It allows you to:

a) ignore any search results that are in between quotes – e.g., my first example of [=LEFT("Hel,lo",5)] – it will now ignore the first comma

b) specify how many levels of nested parentheses you're willing to search in – e.g., so you can ignore the first close-parenthesis in [=LEFT("HELLO",IF(A1=1,3,4))]

In your code, replace the three "InStr" lines with the following:

lFuncPos = InStrFunc(cell.Formula, UCase$(strName), -1000, False)
lCommaPos = InStrFunc2(lFuncPos + 1, cell.Formula, ",", 1, True)
lEndParenPos = InStrFunc2(lCommaPos + 1, cell.Formula, ")", -1, True)

InStrFunc is a wrapper for InStrFunc2 which will set the starting position to 1. The first 2 (or 3, for InStrFunc2) arguments are the same as for the built-in InStr. The 3rd argument sets the number of nested parentheses you want to dig into, with -1000 being a special value indicating infinity. The final argument, is true, means that you want to search in EXACTLY the number of nested parentheses of the previous argument, and if false, AT MOST that number.

So, the first line searches for strName in any level of nested parentheses. The second line starts from the result of the first line, and searches for a comma in exactly one set of nested parentheses. The third line searches for the closing parenthesis for the function we're currently in, i.e., exactly one nested parentheses ABOVE the current place (hence the -1).

Below are the functions themselves. Peder, it should be trivial to change the lines above to work with your code.

'wrapper function for when no start position is specified
Function InStrFunc(str As String, findStr As String, maxNested As Integer, exactNested As Boolean) As Integer
    InStrFunc = InStrFunc2(1, str, findStr, maxNested, exactNested)
End Function

' maxNested sets the number of nested parentheses you're willing to dig into (-1000 means infinite)
' exactNested - if true, search in exactly number of nested parentheses indicated in maxNested, otherwise at most that number
' function returns 0 if string is not found
Function InStrFunc2(startPos As Integer, str As String, findStr As String, maxNested As Integer, exactNested As Boolean) As Integer
    Dim opParen As String, clParen As String, quote As String, apostr As String
    Dim nextChar As String, nextSrchChars As String
    Dim insideString As Boolean, insideExtRef As Boolean, ignoreNested As Boolean
    Dim numNestedParens As Integer, lenFindStr As Integer
    opParen = "("
    clParen = ")"
    quote = """"
    apostr = "'"
    insideString = False
    insideExtRef = False
    numNestedParens = 0
    lenFindStr = Len(findStr)
    If maxNested = -1000 Then
        ignoreNested = True
    Else
        ignoreNested = False
    End If

    Dim i As Integer
    For i = startPos To Len(str)
        nextChar = Mid(str, i, 1) ' next character in string - to check if we're in a string, parentheses, etc.
        nextSrchChars = Mid(str, i, lenFindStr) ' next X characters - to check if they match the string we're searching for
        If insideString Then    ' we're inside a string, so ignore everything except an end-quote
            If nextChar = quote Then
                insideString = False
            End If
        ElseIf insideExtRef Then    ' we're inside a reference to another file, so ignore everything except an apostrophe
            If nextChar = apostr Then
                insideExtRef = False
            End If
        Else
            If nextChar = quote Then
                insideString = True
            ElseIf nextChar = apostr Then
                insideExtRef = False
            ElseIf nextChar = opParen Then
                numNestedParens = numNestedParens + 1
            ElseIf nextChar = clParen Then
                numNestedParens = numNestedParens - 1
            End If

            If Not (insideString Or insideExtRef) Then
                If (ignoreNested) Or (exactNested And numNestedParens = maxNested) Or ((Not exactNested) And numNestedParens <= maxNested) Then
                    If StrComp(findStr, nextSrchChars) = 0 Then
                        InStrFunc2 = i
                        Exit Function
                    End If
                End If
            End If
        End If
    Next i
    InStrFunc2 = 0
End Function

Comments on this article are closed. Why?