Hi There,

I would like to replace the cells in "my selection" which contain a
Subtotal-formula
with a new one:

eg:
=SUBTOTAL(9;XXX***:XXX***)
should become
=SUBTOTAL(9;XXX***:Above)

=SUBTOTAL(11;YYY***:YYY***)
should become
=SUBTOTAL(11;YYY***:Above)

Where "Above" is defined name which I create as follows:
ActiveWorkbook.Names.Add Name:="Above", RefersToR1C1:= _
"=INDIRECT(""R[-1]C"",0)"

Thanks for your insight!
Sige

Sub EFGH()
Dim cell As Range, s As String, s1 As String
Dim iloc As Long
For Each cell In Selection.SpecialCells(xlFormulas)
s = cell.Formula
If InStr(1, s, "Subtotal", vbTextCompare) Then
iloc = InStr(1, s, ":", vbTextCompare)
s1 = Mid(s, iloc + 1, (Len(s) - iloc) - 1)
s = Replace(s, s1, "Above")
cell.Formula = s
End If
Next

End Sub

--
Regards,
Tom Ogilvy


"Sige" wrote:

Hi There,

I would like to replace the cells in "my selection" which contain a
Subtotal-formula
with a new one:

eg:
=SUBTOTAL(9;XXX***:XXX***)
should become
=SUBTOTAL(9;XXX***:Above)

=SUBTOTAL(11;YYY***:YYY***)
should become
=SUBTOTAL(11;YYY***:Above)

Where "Above" is defined name which I create as follows:
ActiveWorkbook.Names.Add Name:="Above", RefersToR1C1:= _
"=INDIRECT(""R[-1]C"",0)"

Thanks for your insight!
Sige

Hi Tom,

Thanks a lot!!!

There is still an issue ( or 2 ;-) ) though:
1. If I just select 1 cell ...it works on the whole sheet!
2. If there there is a subtotal working on just 1row, like eg:
=SUBTOTAL(9;E2:E2) then I get:
=SUBTOTAL(9;Above:Above) which normally operates fine!
Though in the bizar case that it I have 2nd, 3rd, 4 th level etc
-subtoals working on 1 row like:

E24: 3000
E25: =SUBTOTAL(9;E24:E24) result 3000
E26: =SUBTOTAL(9;E24:E24) result 3000
E26: =SUBTOTAL(9;E24:E24) result 3000
E27: =SUBTOTAL(9;E24:E24) result 3000

my output does returns:
3000
=SUBTOTAL(9;Above:Above) result 3000
=SUBTOTAL(9;Above:Above) result 0
=SUBTOTAL(9;Above:Above) result 0
=SUBTOTAL(9;Above:Above) result 0

I create these subtotals (1st, 2nd, higher level) automatically. On
rather big lists, in which I unfortunately have too many of these
"exceptions".

Is there a way to resolve this??
Sige

This does what it should ... honours to Tom though!

Sub ABCD()
Dim cell As Range, s As String, s1 As String
Dim iloc As Long, jloc As Long

ActiveWorkbook.Names.Add Name:="Above", RefersToR1C1:= _
"=INDIRECT(""R[-1]C"",0)"
If Selection.Count = 1 Then
MsgBox "Select a Range with more than 1 Cell to Insert ""Above"" in
Subtotal-formulas"
Exit Sub
End If
For Each cell In Selection.SpecialCells(xlFormulas)
s = cell.Formula
If InStr(1, s, "Subtotal", vbTextCompare) Then
iloc = InStr(1, s, ":", vbTextCompare)

jloc = InStr(1, s, ")", vbTextCompare)

s1 = Mid(s, iloc, (jloc - iloc))
s = Application.Substitute(s, s1, ":Above")
cell.Formula = s
End If
Next

End Sub