Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Ted Collins   on Dec 01 In MS Office Category.

  
Question Answered By: Jamie Roberts   on Dec 01

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

Share: 

 

This Question has 11 more answer(s). View Complete Question Thread

 
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.


Tagged: