Remove functions from your formulas
December 9, 2008 • JP • No Comments • Rate This Article
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.
' 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", , , , , , , 8)
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.
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.
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.
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.
' 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:
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.
(No Ratings Yet)
Loading ...What now?
Subscribe To The Blog
Email This Article
Follow Me On Twitter
My Facebook Page
Or just keep reading:
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 if you want to learn more about VBA. Keep Reading »
Previous Post: The Wrong Way to Declare Application Objects
Next Post: My guitar rig drawn in Excel
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:
' 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
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))].
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.
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):
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:
' 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
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:
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.
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