Subtotal Results question

[Richardb]

I have a spreadsheet which subtotals several cells using the subtotal menu
function. As you can see below the cells I am using. I would like it to also
insert the cell that has the HD4715 in with the totals line. Is there a way
to do this rather than have to go through a lot of copying and pasting. After
I subtotal I usual hide the detail rows. Any help would be appreciated.

Richard

Abitia, Monica B Abitia Monica 1/29/2007 HD4715 7.5
Abitia, Monica B Abitia Monica 1/30/2007 HD4715 7.5
Abitia, Monica B Abitia Monica 1/31/2007 HD4715 7.75
Abitia, Monica B Abitia Monica 2/1/2007 HD4715 7.75
Abitia, Monica B Abitia Monica 2/2/2007 HD4715 8
Abitia, Monica B Total 38.5

 

[Jim Cone]

Here is some code you can try on a copy of your worksheet...
(click a cell within the sub-totaled data before running it)
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)


Sub FillInTheBlanks()
'Calls function.
Dim lngTitleColumn As Long
Dim lngTotalColumn As Long
lngTitleColumn = 1 '<<< Use the first column number of your data
lngTotalColumn = 5 '<<< Use the column number with the totals
'Call Function
FillSubTotalBlanks ActiveCell, lngTitleColumn, lngTotalColumn
End Sub
'----------

Function FillSubTotalBlanks(ByRef rngCell As Range, _
ByRef lngFirst As Long, ByRef lngLast As Long)
'Jim Cone - San Francisco USA - January 2007
Dim rng As Range
Dim lngRow As Long
Dim strItem As String
Dim dblTotal As Double
Set rng = rngCell.CurrentRegion

For lngRow = 1 To rng.Rows.Count - 1
If InStr(1, rng.Cells(lngRow, lngLast).Formula, _
"SUBTOTAL", vbTextCompare) > 0 Then
strItem = rng.Cells(lngRow, lngFirst).Text
dblTotal = rng.Cells(lngRow, lngLast).Value2
Range(rng.Rows(lngRow - 1), rng.Rows(lngRow)).FillDown
rng.Cells(lngRow, lngFirst).Value = strItem
rng.Cells(lngRow, lngFirst).Font.Bold = True
rng.Cells(lngRow, lngLast).Value = dblTotal
rng.Cells(lngRow, lngLast).Font.Bold = True
strItem = vbNullString
dblTotal = 0
End If
Next 'lngRow

Application.DisplayAlerts = False
rng.RemoveSubtotal
Application.DisplayAlerts = True
Set rng = Nothing
Set rngCell = Nothing
End Function
'-----------------------------------




"Richardb"
wrote in message
I have a spreadsheet which subtotals several cells using the subtotal menu
function. As you can see below the cells I am using. I would like it to also
insert the cell that has the HD4715 in with the totals line. Is there a way
to do this rather than have to go through a lot of copying and pasting. After
I subtotal I usual hide the detail rows. Any help would be appreciated.
Richard

Abitia, Monica B Abitia Monica 1/29/2007 HD4715 7.5
Abitia, Monica B Abitia Monica 1/30/2007 HD4715 7.5
Abitia, Monica B Abitia Monica 1/31/2007 HD4715 7.75
Abitia, Monica B Abitia Monica 2/1/2007 HD4715 7.75
Abitia, Monica B Abitia Monica 2/2/2007 HD4715 8
Abitia, Monica B Total 38.5

 

[Richardb]

Thanks, will try it.