Extract from subtotals



I have two lists in separate spreadsheets with two columns in common, an ID
and an amount. These are columns B and C in both lists.

The amounts in one of the lists are positive and in the other they are
There are more than one occurance of some IDs in both lists. One of these
delightful little many-to-many relations.

When I merge the two lists, sort them using the IDs and calculate subtotals
most of these add to zero. The number of items in each subtotal is not the
same and not known in advance.

It is only the lines that produce a subtotal different from zero, below or
above, that I want to keep.

Copying the view where only the subtotals are shown, using
specialcells(xlvisible) whould make the details of the subtotals I am
interested in dissapear. This is not an option since it is this hidden
information I want to extract.

Is there a reasonably easy way to solve this?
A solution could be a macro that would expand all subtotals that are not
zero, or one that would remove all rows making up any subtotal that is zero.

By the way, there may be rows where a single value is zero, but the subtotal
it is part of is not. These rows must not be delated.

Looking forward to any suggestions.

Thank you.



Tom Ogilvy

Based on your descriptions I would assume there is some value in column A of
each row and thus, the subtotal line should be blank in column A

so some starter code might be:

Sub DeleteZeroSets()
Dim rng1 as Range, rng2 as Range
dim rng as Range, rng3 as Range
set rng1 = Range("A2")
set rng = Columns(1).specialCells(xlBlanks)
for each cell in rng
set rng2 = Range(rng1,cell)
if cell.offset(0,2) = 0 then
if rng3 is nothing then
set rng3 = rng2
set rng3 = union(rng3,rng2)
end if
set rng1 = cell.offset(1,0)
if not rng3 is nothing then
' rng3.EntireRow.Delete
End if
End Sub

This will select the rows to delete for your inspection. If you are
satisfied the macro works, then uncomment rng3.EntireRow.Delete

there is also the possibility of floating point imprecision. If it seems to
skip some sets that appear to be zero, you may find they are a very small
fraction. You could use

if Abs(cell.offset(0,2).Value) < .00001 then

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