Subtotal
 

Can anyone tell me how I can amend the macro below works for cells
containing both values & formulas in the areas

Sub subtotalrange()
'

'
For Each NumRange In Selection.SpecialCells(xlConstants,
xlNumbers).Areas

SumAddr = NumRange.Address(False, False)
NumRange.Offset(NumRange.Count, 1).Resize(1, 1).Formula =
"=SUBTOTAL(9," & SumAddr & ")"

Next NumRange
'
End Sub

Thxs

Subtotal
 

Hi Al007,

Try:
'================
Public Sub SubtotalRange()
Dim RngA As Range, RngB As Range
Dim RngBig As Range
Dim NumRange As Range
Dim SumAddr As String
Dim CalcMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

On Error Resume Next
Set RngA = Selection.SpecialCells(xlCellTypeConstants)
Set RngB = Selection.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0

If Not RngA Is Nothing Then Set RngBig = RngA

If Not RngB Is Nothing Then
If Not RngBig Is Nothing Then
Set RngBig = Union(RngB, RngBig)
Else
Set RngBig = RngB
End If
End If

If Not RngBig Is Nothing Then
For Each NumRange In RngBig.Areas
SumAddr = NumRange.Address(False, False)
NumRange.Offset(NumRange.Count, 1). _
Resize(1, 1).Formula = _
"=SUBTOTAL(9," & SumAddr & ")"
Next NumRange
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'<<================

---
Regards,
Norman



"al007" wrote in message
oups.com...
Can anyone tell me how I can amend the macro below works for cells
containing both values & formulas in the areas

Sub subtotalrange()
'

'
For Each NumRange In Selection.SpecialCells(xlConstants,
xlNumbers).Areas

SumAddr = NumRange.Address(False, False)
NumRange.Offset(NumRange.Count, 1).Resize(1, 1).Formula =
"=SUBTOTAL(9," & SumAddr & ")"

Next NumRange
'
End Sub

Thxs

Subtotal
 

Hi Normal'
Thxs a lot - the macro is working fine so far - will keep u posted in
case I come across any problem - specially I using it also with an
offset = 0
May many thxs


Norman Jones wrote:
Hi Al007,

Try:
'================
Public Sub SubtotalRange()
Dim RngA As Range, RngB As Range
Dim RngBig As Range
Dim NumRange As Range
Dim SumAddr As String
Dim CalcMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

On Error Resume Next
Set RngA = Selection.SpecialCells(xlCellTypeConstants)
Set RngB = Selection.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0

If Not RngA Is Nothing Then Set RngBig = RngA

If Not RngB Is Nothing Then
If Not RngBig Is Nothing Then
Set RngBig = Union(RngB, RngBig)
Else
Set RngBig = RngB
End If
End If

If Not RngBig Is Nothing Then
For Each NumRange In RngBig.Areas
SumAddr = NumRange.Address(False, False)
NumRange.Offset(NumRange.Count, 1). _
Resize(1, 1).Formula = _
"=SUBTOTAL(9," & SumAddr & ")"
Next NumRange
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'<<================

---
Regards,
Norman



"al007" wrote in message
oups.com...
Can anyone tell me how I can amend the macro below works for cells
containing both values & formulas in the areas

Sub subtotalrange()
'

'
For Each NumRange In Selection.SpecialCells(xlConstants,
xlNumbers).Areas

SumAddr = NumRange.Address(False, False)
NumRange.Offset(NumRange.Count, 1).Resize(1, 1).Formula =
"=SUBTOTAL(9," & SumAddr & ")"

Next NumRange
'
End Sub

Thxs