sub tot column to next blank cell when blank cell exists in both c

G

GaiGauci

I have posted this again to hope that someone will give me further assistance
- I "ticked" the last post because it did work and well, but I realised what
I actually need is slightly different.

I asked for some coding that would search for each blank cell in a column
and subtotal below it until the next blank cell. Stefi gave me this:

Sub stotal()
Range("S1").End(xlDown).Activate
Range("S" & ActiveCell.Row - 1).Activate
Do While ActiveCell.Row <> Range("S" & Rows.Count).End(xlUp).Row + 1
stotstart = ActiveCell.Row + 1
stotend = Range("S" & ActiveCell.Row + 1).End(xlDown).Row
ActiveCell.Formula = "=SUBTOTAL(9,S" & stotstart & ":S" & stotend &
")"
Range("S" & stotend + 1).Activate
Loop
End Sub

BUT... what I realised when I put it into play was that what I really need
was it to subtotal when both S and T columns are both empty at the same time,
because there are odd cells that are empty but are not a sub total row. It is
only those rows that have both S and T columns (the total columns) empty that
are the subtotal columns.

I was guessing something like....

Range("S1").End(xlDown).Activate
Range("S" & ActiveCell.Row - 1).Activate
Do While ActiveCell.Row <> Range("S:T" & Rows.Count).End(xlUp).Row + 1
stotstart = ActiveCell.Row + 1
stotend = Range("S" & ActiveCell.Row + 1).End(xlDown).Row
with selection.font
.font = 11
.bold = true
ActiveCell.Formula = "=subtotal(9,S" & stotstart & ":S" & stotend & ")"
Range("S" & stotend + 1).Activate
Nextstotstart = ActiveCell.Row + 1, ActiveCell.column +1
Nextstotend = Range("T" & ActiveCell.Row + 1).End(xlDown).Row
ActiveCell.Formula = "=subtotal(9,T" & nextstotstart & ":T" &
nextstotend & ")"
Range("S" & stotend + 1).Activate

Loop

What are your thoughts??? I really don't understand coding as well as I
would like so I am just having a stab in the dark.

Cheers
Gai
 
B

Bob Umlas

Try this: Very fast:

Sub SubTots()
Dim ans As Range
Set ans = Nothing
Set rg = Range("S:T").SpecialCells(xlCellTypeBlanks)
For Each chunk In rg
If chunk.Column = 19 And IsEmpty(chunk.Offset(0, 1)) Or _
chunk.Column = 20 And IsEmpty(chunk.Offset(0, -1)) Then
If ans Is Nothing Then
Set ans = chunk
Else
Set ans = Union(ans, chunk)
End If
End If
Next
ans.Select
Application.SendKeys "%="
End Sub
 
G

GaiGauci

Hi Bob. Thanks for the help. It's coming up with a application defined or
user defined error on 5th and 6th lines (ie " If chunk.Column = 19...." . Do
I need to define "chunk". Your a little over my head I'm afraid..
Cheers
Gai
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top