Search:

How to step into a formula with a macro?

Asked By: Ted    Date: Dec 01    Category: MS Office    Views: 492

I have cell BOB. BOB sums A1:A25. I want to be able to click on
a macro that will find BOB then change its formula so it sums A1:A26.
It will +1 cell to the end (A27, then A28, then A29) of the sum range
each time I click the macro. How can I do this?

Share:

Are you sure you need VBA for this? There is a way to sum  to the
cell above which keeps correct range references even after inserting a cell.
Then instead of BOB you could say =Cell where cell  is the one doing the
summing.

The sum  is more of an example. Its not just suming. There's 3
formulas with cell  names:

=NPV(G63/12,\$D\$112:\$D\$183) (bob)
=SUM(C25:C111) (dan)
=SUM(D112:D183) (jim)

I need everymonth to be able to hit this macro  so it moves the
reference cell up one. So next month I will hit the macro and get
the formulas

=NPV(G63/12,\$D\$113:\$D\$183)
=SUM(C25:C112)
=SUM(D113:D183)

In bob, the D112 becomes 113, in Dan, C111 becomes 112, and in Jim
D112 becomes 113. It all basically moved the formulas one cell down.

Not trying to be obstrepelous but if it's a question of only 1 cell  a month
what about setting things up for 12 months and writing stuff to the cells as
the data comes in.

I realy feel that if you could write a formula  rather than code for a
solution you'd be better off.

I'm not a statistician really so I'm not sure how this would affect NVP but
the SUM formulas would be fine.

The problem with expanding the formuals with VBA is picking up the current
range to be expanded. Writing a formula to a cell is simple.
With string manipulation it wouldn't be too tricky tho as long as the target
cell is static so you could put a user function in there.
Are there any empty cells in the range to be SUMed NVPeed?

Its more a matter of going into 3 cells' formulas per sheet for
about 100 sheets per month and the three cells aren't all in the
same place so I have to go to each sheet and look for it, scrolling
up and down in some very BIG sheets and update the formulas each
month which is a time  drain. If I could go to each sheet, hit a hot
key, then move on it would speed things up considerably. I don't
know of a formula  solution for this. Its not a hard thing to do
every month just tedious and inefficiently time consuming. If you
know of a formula solution, I would love to try it.

For now I have this for VBE script:

Private Sub IncreaseFormulaRangeByOne(RangeName As String, Boundary
As ExpandWhichBoundary)

' Initialize
Dim MessagePrefix As String
MessagePrefix = "IncreaseFormulaRangeByOne: field '" & RangeName
& "': "

On Error GoTo NoRange
Dim CurrentFormula As String
CurrentFormula = Range(RangeName).Formula
On Error GoTo 0

' Test parameter to ensure it encompasses only one cell.
If Range(RangeName).Cells.Count <> 1 Then
MsgBox MessagePrefix & "Cannot change  the formula(s) of a
range of cells."
Exit Sub
End If

' The cell  had better contain a formula
If Left(CurrentFormula, 1) <> "=" Then
MsgBox MessagePrefix & "Does not contain a formula."
Exit Sub
End If

' Any field whose nameis passed to this routine had better
contain a sum  formula.
' SUM(AA123:AA456)
' |
Dim SumCharNdx As Integer
SumCharNdx = InStr(CurrentFormula, "SUM")
If SumCharNdx = 0 Then SumCharNdx = InStr
(CurrentFormula, "NPV") ' alternat sort of SUM
If SumCharNdx > 0 Then
' There had better be a colon after the aggregate function
name somewhere.
' SUM(AA123:AA456)
' |
Dim ColonCharNdx As Integer
ColonCharNdx = InStr(SumCharNdx + 3, CurrentFormula, ":")
If ColonCharNdx > 0 Then
Dim PartOfRange As String
Dim CurrentCharNdx As Integer
Dim RowNumber As Integer
RowNumber = 0
Dim RowNumberNdxStart As Integer
RowNumberNdxStart = 0
Dim RowNumberNdxEnd As Integer
Select Case Boundary
Case Upper
' Walk through the characters after the colon,
looking for capital alphas followed by digits.
' SUM(AA123:AA456)
' |
For CurrentCharNdx = ColonCharNdx + 1 To Len
(CurrentFormula)
CurrentChar = Mid(CurrentFormula,
CurrentCharNdx, 1)
' Allow column/row designators to
contain "\$".
If (CurrentChar >= "A" And CurrentChar
< "Z") Or CurrentChar = "\$" Then
' do nothing
Else
' There had better be numbers now.
' SUM(AA123:AA456)
' |
If RowNumberNdxStart = 0 Then
RowNumberNdxStart = CurrentCharNdx
If CurrentChar >= "0" And CurrentChar
<= "9" Then
RowNumber = RowNumber * 10 + CInt
(CurrentChar)
Else
RowNumberNdxEnd = CurrentCharNdx - 1
Exit For
End If
End If
Next
PartOfRange = "second"

Case Lower
' Walk through the characters preceding the
colon, looking for digits.
' SUM(AA123:AA456)
' |
Dim Multiplier As Integer
Multiplier = 1
For CurrentCharNdx = ColonCharNdx - 1 To 0 Step -
1
CurrentChar = Mid(CurrentFormula,
CurrentCharNdx, 1)
If RowNumberNdxEnd = 0 Then RowNumberNdxEnd
= CurrentCharNdx
If CurrentChar >= "0" And CurrentChar <= "9"
Then
RowNumber = RowNumber + (CInt
(CurrentChar) * Multiplier)
Multiplier = Multiplier * 10
Else
RowNumberNdxStart = CurrentCharNdx + 1
Exit For
End If
Next
PartOfRange = "first"

End Select

' There had better have been a number in one of these
ranges.
' SUM(AA123:AA456)
' | | (Upper)
' SUM(AA123:AA456)
' | | (Lower)
If RowNumber = 0 Then
MsgBox MessagePrefix & "does not contain a valid row
number in the " & PartOfRange & " part of its range."
Else
' Perform the replacement
Dim NewFormula As String
Dim NewRowNumber As String
Select Case Boundary
Case Upper
NewRowNumber = CStr(RowNumber + 1)
Case Lower
NewRowNumber = CStr(RowNumber - 1)
End Select
NewFormula = Left(CurrentFormula, RowNumberNdxStart -
1) & _
NewRowNumber & _
Mid(CurrentFormula, RowNumberNdxEnd
+ 1, Len(CurrentFormula))
Range(RangeName).Formula = NewFormula
MsgBox MessagePrefix & "was updated from '" &
CurrentFormula & "' to '" & NewFormula & "'"
End If
Else
MsgBox MessagePrefix & "does not contain a SUM of a
range of cells."
End If
Else
MsgBox MessagePrefix & "does not contain a SUM."
End If
Exit Sub

NoRange:
MsgBox MessagePrefix & "there is no field named '" & RangeName
& "'"
End Sub

if I've misunderstood what you are trying to do - but have you
considered using Offset in your formula?

I'm not too familar with offset. I'm just learning vbe on the fly as
I go here :) I've done this for the "sum" bit and it works but I'm
not sure how to get it to works but its clunky (but maybe that's my
built in error checking). If you can improve upon it with offset
that would be marvelous!:

Private Sub IncreaseFormulaRangeByOne(RangeName As String)

' Initialize
Dim MessagePrefix As String
MessagePrefix = "IncreaseFormulaRangeByOne: field '" & RangeName
& "': "

On Error GoTo NoRange
Dim CurrentFormula As String
CurrentFormula = Range(RangeName).Formula
On Error GoTo 0

' Test parameter to ensure it encompasses only one cell.
If Range(RangeName).Cells.Count <> 1 Then
MsgBox MessagePrefix & "Cannot change  the formula(s) of a
range of cells."
Exit Sub
End If

' The cell  had better contain a formula
If Left(CurrentFormula, 1) <> "=" Then
MsgBox MessagePrefix & "Does not contain a formula."
Exit Sub
End If

' Any field whose nameis passed to this routine had better
contain a sum  formula.
' SUM(AA123:AA456)
' |
Dim SumCharNdx As Integer
SumCharNdx = InStr(CurrentFormula, "SUM")
If SumCharNdx > 0 Then
' There had better be a colon after the SUM somewhere.
' SUM(AA123:AA456)
' |
Dim ColonCharNdx As Integer
ColonCharNdx = InStr(SumCharNdx + 3, CurrentFormula, ":")
If ColonCharNdx > 0 Then
' Walk through the characters after the colon, looking
for capital alphas followed by integers.
' SUM(AA123:AA456)
' |
Dim CurrentCharNdx As Integer
Dim RowNumber As Integer
RowNumber = 0
Dim RowNumberNdxStart As Integer
RowNumberNdxStart = 0
Dim RowNumberNdxEnd As Integer
For CurrentCharNdx = ColonCharNdx + 1 To Len
(CurrentFormula)
CurrentChar = Mid(CurrentFormula, CurrentCharNdx, 1)
If CurrentChar >= "A" And CurrentChar < "Z" Then
' do nothing
Else
' There had better be numbers now.
' SUM(AA123:AA456)
' |
If RowNumberNdxStart = 0 Then RowNumberNdxStart
= CurrentCharNdx
If CurrentChar >= "0" And CurrentChar <= "9" Then
RowNumber = RowNumber * 10 + CInt
(CurrentChar)
Else
RowNumberNdxEnd = CurrentCharNdx - 1
Exit For
End If
End If
Next
' There had better have been a number in the range.
' SUM(AA123:AA456)
' | |
If RowNumber = 0 Then
MsgBox MessagePrefix & "does not contain a valid row
number in the second part of its range."
Else
' Perform the replacement
Dim NewFormula As String
Dim NewRowNumber As String
NewRowNumber = CStr(RowNumber + 1)
NewFormula = Left(CurrentFormula, RowNumberNdxStart -
1) & _
NewRowNumber & _
Mid(CurrentFormula, RowNumberNdxEnd
+ 1, Len(CurrentFormula))
Range(RangeName).Formula = NewFormula
MsgBox MessagePrefix & "was updated from '" &
CurrentFormula & "' to '" & NewFormula & "'"
End If
Else
MsgBox MessagePrefix & "does not contain a SUM of a
range of cells."
End If
Else
MsgBox MessagePrefix & "does not contain a SUM."
End If
Exit Sub

NoRange:
MsgBox MessagePrefix & "there is no field named '" & RangeName
& "'"
End Sub

Public Sub MonthlyFormulaUpdate()
IncreaseFormulaRangeByOne "Projected"
End Sub

Yes, Offset should do it. You can store the amount of offset in a
cell somewhere so it will be saved with the file.

You can also look at using CurrentRegion e.g.:
Range("BOB").CurrentRegion.Select

This expands the range to include all adjacent non-blank cells, so
only works if your range is surrounded by blanks cells.

I agree with the other responses that wonder what you're trying to do, but ...

You can get at cell  BOB as before:

Range("BOB")

Its formula  is available through its .Formula property or its .FormulaR1C1
property. Both give you the formula as a text string - just in different
formats. Work out which one you prefer to use.

You will need to split the formula string into its component parts. Presumably
the formula is

=Sum(A1:A25)

You'll need to separate out the 25 and make it 26, then put it all back together
and assign it to the .Formula or .FormulaR1C1 property of BOB.

Are you sure this is what you want. It isn't moving the formulas one cell  down.
It is lengthening DAN and shortening BOB and JIM. This is not the same thing at
all and is also harder to do.

If you simply want to move the formula  once cell down - i.e. C25:C111 becomes
C26:C112, then you could offset your original formula by an amount, using the
Offset range function (see the help for information on this).

There is a non-VBA of doing this that might be more appropriate. E.g., I have a
column of numbers in Column A from 1 down, and in E8 I have the row number that
is to be the bottom of my sum. Then:

=SUM(INDIRECT("A1:A"&E8))

Or, for your three - assuming E8 has 112 in it:

=NPV(G63/12,INDIRECT("\$D\$" & E16 & ":\$D\$183"))
=SUM(INDIRECT("C25:C" & (E16 - 1)))
=SUM(INDIRECT("D" & E16 & ":D183"))

Any reason why your first formula has \$ anchors on the range while the third
does not (with an identical range)?

That is exactly what I want. I want C25:c111 ot become c25:c112 so
it lengthens the range of the formula. It should not just move the
range down one. The other two require the range to shorten.

Actually I think you've brilliantly simplified this script for me. I
didn't think of using indirect. Is there a way to script for excel

Find green cell
Return row number of green cell  as value in cell A1.

What I want is to color the cell that these formulas depend on
green. Move the green cell down one every month and have the cell A1
read this and return the new row # automatically as a value. Then I
can use the indirect formula  to cause all other formulas to auto
update.

If you want to find  a cell  by colour, you can certainly do so. From memory, you
need the Interior property of the cell, and probably the PatternColor property
of that ...

Range("a1").Interior.PatternColor

However, you're better using other information to tell you where the green cell
should be, and then make it green.

Normally, I'd use conditional formatting for conditional colouring like this.

Didn't find what you were looking for? Find more on How to step into a formula with a macro? Or get search suggestion and latest updates.