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