How about this:

Insert headers into row 1 first.

Then insert a new column A. Fill that range with 1's.

Apply data|subtotal
Copy column A
edit|paste special values

Filter on that column for 1's and filter on column B for "*subtotal".

Delete those 1's that you see.

Remove the filter and delete column A.

Here's what I got:

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim LastRow As Long
Dim myRng As Range

Set wks = ActiveSheet

With wks

.AutoFilterMode = False
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns(1).Insert
.Range("A2:a" & LastRow).Value = 1

'30 columns + one inserted
Set myRng = .Range("a1:a" & LastRow).Resize(, 31)

Application.DisplayAlerts = False
myRng.Subtotal groupby:=2, Function:=xlSum, totallist:=Array(1, 3), _
Replace:=True, pagebreaks:=False, _
summarybelowdata:=xlSummaryBelow
Application.DisplayAlerts = True

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range("a1:a" & LastRow)

.Columns(1).Value = .Columns(1).Value

myRng.RemoveSubtotal

myRng.Resize(, 2).AutoFilter field:=1, Criteria1:="1"
myRng.Resize(, 2).AutoFilter field:=2, Criteria1:="*total"

On Error Resume Next
myRng.Offset(1, 0).Resize(myRng.Rows.Count - 1, 1) _
.Cells.SpecialCells(xlCellTypeVisible).EntireRow.D elete
On Error GoTo 0

.AutoFilterMode = False
.Columns(1).Delete
End With

End Sub

Alternatively, you could start at the bottom and just loop your way up:

Option Explicit
Sub testme02()

Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim botCell As Range
Dim topCell As Range
Dim wks As Worksheet

Set wks = ActiveSheet

With wks
FirstRow = 2
.Rows(FirstRow).Insert
.Cells(FirstRow, "A").Value = "dummyVal"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

Set topCell = .Cells(LastRow, "A")
Set botCell = .Cells(LastRow, "A")
For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
Set topCell = .Cells(iRow - 1, "A")
Else
If topCell.Address = botCell.Address Then
'do nothing
Else
botCell.Offset(1, 0).EntireRow.Insert
botCell.Offset(1, 1).Formula _
= "=subtotal(9," & topCell.Offset(0, 1).Address(0, 0) _
& ":" & botCell.Offset(0, 1).Address(0, 0) & ")"
botCell.Offset(1, 0).Value = "Subtotal: " & botCell.Value
End If
Set botCell = .Cells(iRow - 1, "A")
Set topCell = .Cells(iRow - 1, "A")
End If
Next iRow

.Rows(FirstRow).Delete

End With

End Sub

I did insert a dummyVal in a new row--to make checking that final group easier.
I delete it when I'm done.




joanne mckinstry wrote:

I am unable to use the Data/Subtotal function since my spreadsheet is so
large and I have many, many columns. About 50% of the rows have a
single qualifier so I do not want to subtotal them. If I use the
data/Subtotal function, my spreadsheet will look something like this
A B C D
101 25 cf a
101 26 df b
101 30 cf c
Sum 101 81
201 96 df d
Sum 201 96
301 87 if e
301 45 xl f
Sum 301 132
When I hit the buttons to hide the specific subtotals it does not hide
the SUM line it hides the line with all the information and I need to
see the information in the "c" and "d" column. Pivot tables will not
work since I have too much information to put on one. In total the
spreadsheet has about 30 columns and I want to subtotal 2 of the columns
only if they have more than one qualifier. So coniserdering the real
spreadsheet I am working with has about 1000 rows and 30 or so columns,
I think that the best way to go is programming. I hope I got specific
enough and I hope that you are able to help. I know how to Subtotal more
than one column, my only problem is writting the macro that will ignore
lines that have one qualifier.
Thank-you so much for any help

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

--

Dave Peterson