VBA infinite replace loop-CodePudding

I have a workbook with many sheets containing CUBEVALUE formulas. My goal is to wrap these in NUMBERVALUE(), so that null values are shown as zero instead and formulas do not break.

Below is the code I have so far, this works for the most part. However, after replacing the original "CUBEVALUE(" with "NUMBERVALUE(CUBEVALUE(", the VBA keeps replacing the new CUBEVALUE again infinitely. I want to make the VBA stop after changing each cell once.

Current: =CUBEVALUE(formula)

Goal: = NUMBERVALUE(CUBEVALUE(formula))

Sub cube_to_numbercube()
    Dim ws As Worksheet
    On Error Resume Next
        For Each ws In ActiveWorkbook.Worksheets
            For Each cell In ws.Cells.SpecialCells(xlCellTypeFormulas)
                     If cell.Formula Like "*CUBEVALUE*" Then
                     ws.Range("A:C").Replace "=", "placeholder"
                     ws.Range("A:C").Replace "CUBEVALUE(", "NUMBERVALUE(CUBEVALUE("
                     ws.Range("A:C").Replace """]"")", """]""))"
                     ws.Range("A:C").Replace "placeholder", "="
                     End If
            Next cell
        Next ws
End Sub

CodePudding user response：

Your problem is that you have a For Each cell, but then within that, the replace action is happening on ws.Range("A:C") not the individual cell.

Replace all instances of ws.Range("A:C"). with cell. and try again. If you only wish the changes to apply to columns A:C, change your For line to For Each cell in ws.Range("A:C").SpecialCells(xlCellTypeFormulas)

So your updated code should be:

Sub cube_to_numbercube()
    Dim ws As Worksheet
    On Error Resume Next
        For Each ws In ActiveWorkbook.Worksheets
            For Each cell In ws.Range("A:C").SpecialCells(xlCellTypeFormulas)
                     If cell.Formula Like "*CUBEVALUE*" Then
                     cell.Replace "=", "placeholder"
                     cell.Replace "CUBEVALUE(", "NUMBERVALUE(CUBEVALUE("
                     cell.Replace """]"")", """]""))"
                     cell.Replace "placeholder", "="
                     End If
            Next cell
        Next ws
End Sub

CodePudding user response：

Your (inner) loop runs for every single cell containing a formula, but within the loop, you replace all formulas at once. Meaning if you have 100 cells with formulas, your loop will run 100 times and replace every formula containing CUBEVALUE 100 times with NUMBERVALUE(CUBEVALUE(.

Likely at a certain moment, the formula gets too long and Excel will refuse to replace it. This will cause a runtime error but you are hiding all runtime errors with On Error Resume Next.

Now replacing all formulas at once is not a bad idea in general as it will speed up your process. You could remove the inner For Each completely (and the If-statement). However, if for some reasons you need to run the code again (for example because some new formulas where added), you would still have the issue that for every run another NUMBERVALUE-function would be added. Furthermore, the Replace-statement could affect also formulas that shouldn't be affected (for example the 3rd replace statement).

So I would suggest you keep the inner For Each and replace the formula for every cell separately. With that, you can check if the formula really needs to be replaced and it wouldn't be an issue if the code runs several times.

Also, it is easier to do the string handling within VBA. Read the formula into a variable, make the replacement and write it back.

Dim cell As Range, formula As String
For Each cell In ws.Cells.SpecialCells(xlCellTypeFormulas)
    formula = cell.formula
    If formula Like "*CUBEVALUE*" And Not formula Like "*NUMBERVALUE*" Then
        formula = Replace(formula, "CUBEVALUE(", "NUMBERVALUE(CUBEVALUE(")
        formula = Replace(formula, """]"")", """]""))")
        cell.formula = formula
    End If
Next cell

And get rid of the On Error Resume Next - this statement will not prevent runtime errors, it simply doesn't show them which means that you will not be informed if something fails.