Insert a string into formulas in a range using VBA

[Tresfjording]

Hi....
I have made this macro in VBA:

Sub ErstattTxt()

'definitions
Dim i As Long
Dim OldFormula As String
Dim OldFormula2 As String
Dim NewFormula As String

'loopstart
i = 1

'grabbing exsisting formula in active cell
OldFormula = ActiveCell.Formula

'Remove the =character in exisiting formula
OldFormula2 = WorksheetFunction.Substitute(OldFormula, "=", "")

'Defining the new formula
NewFormula = "=iferror(" & OldFormula2 & ";"")"

'checking if active cell is not empty
Do While ActiveCell(i, ActiveCell.Value) <> ""

'Insert new parts of old formulas
If ActiveCell(i, ActiveCell).Formula = OldFormula Then

'write new formula to cell
ActiveCell.Formula = NewFormula 'heres were it all goes wrong

'move cursor one cell down
ActiveCell.Offset(1).Select
End If

'Repeat 5 times (or column down)
If i = 5 Then End

i = i + 1

Loop

End Sub

I get no errors, but the formula in active cell do not change.

What I am trying to do is to add =iferror( to the beginning, and ;"") to the end, of all formulas in a column of cells. The formulas are all different.
The problem is that the variable NewFormula do not end up as a formula in active cell.

What am I doing wrong?

 

[RoryA]

I'm not sure what you are trying to do with this bit?

ActiveCell(i, ActiveCell.Value)

You could try something like this:

Sub AddIfError()
    Dim rCell                 As Range
    Dim rFormulas             As Range

    If Selection.Count = 1 Then
        If Selection.HasFormula Then Set rFormulas = Selection
    Else
        On Error Resume Next
        Set rFormulas = Selection.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0
    End If

    If rFormulas Is Nothing Then
        MsgBox "No formulas in selection"
    Else
        For Each rCell In rFormulas
            If UCase$(Left$(rCell.Formula, 8)) <> "=IFERROR" Then
                If rCell.HasArray Then
                    rCell.CurrentArray.FormulaArray = "=IFERROR(" & Mid$(rCell.FormulaArray, 2) & ","""")"
                Else
                    rCell.Formula2 = "=IFERROR(" & Mid$(rCell.Formula2, 2) & ","""")"
                End If
            End If
        Next rCell
    End If
End Sub

Just select the cells you want before running it.

 

[Tresfjording]

Thanm you .... worked perfect. )