Adding to a formula in cell without deleting formula
Let's say cell A5 has the following formula in it: =SUM(A1:A5)
I want to use VBA add 1 to this formula to make it =SUM(A1:A5) + 1
I have tried Range("A5") = Range("A5") + 1 but this has just changed it a hard coded number rather than a formula + 1. How can I approach this problem?
Thanks for the help!
something like this which includes a test for formula existence
If Range("A5").HasFormula Then Range("A5").Formula = Range("A5").Formula & "+1"
Update: And to do this very quickly on large selection of cells automatically updating only formulae you should use variant arrays
change strAdd = "+1" for your suffix appending
'Press Alt + F11 to open the Visual Basic Editor (VBE) 'From the Menu, choose Insert-Module. 'Paste the code into the right-hand code window. 'Press Alt + F11 to close the VBE 'In Xl2003 Goto Tools … Macro … Macros and double-click UpdateFormulae Sub UpdateFormulae() Dim rng1 As Range Dim rngArea As Range Dim lngRow As Long Dim lngCol As Long Dim lngCalc As Long Dim X() Dim strAdd As String On Error Resume Next Set rng1 = Application.InputBox("Select range for the replacement of forumlae", "User select", Selection.Address, , , , , 8) Set rng1 = rng1.SpecialCells(xlCellTypeFormulas) If rng1 Is Nothing Then Exit Sub On Error GoTo 0 strAdd = "+1" 'Speed up the code by turning off screenupdating and setting calculation to manual 'Disable any code events that may occur when writing to cells With Application lngCalc = .Calculation .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False End With 'Test each area in the user selected range 'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on For Each rngArea In rng1.Areas 'The most common outcome is used for the True outcome to optimise code speed If rngArea.Cells.Count > 1 Then 'If there is more than once cell then set the variant array to the dimensions of the range area 'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks X = rngArea.Formula For lngRow = 1 To rngArea.Rows.Count For lngCol = 1 To rngArea.Columns.Count 'replace the leading zeroes X(lngRow, lngCol) = X(lngRow, lngCol) & strAdd Next lngCol Next lngRow 'Dump the updated array with new formulae back over the initial range rngArea.Value2 = X Else 'caters for a single cell range area. No variant array required rngArea.Value2 = rngArea.Formula & strAdd End If Next rngArea 'cleanup the Application settings With Application .ScreenUpdating = True .Calculation = lngCalc .EnableEvents = True End With End Sub