Filter, Subtotal and move

Steven123

New Member
Joined
Jun 19, 2002
Messages
18
Hi Excel experts!

Does anyone know how to do the following with a macro.

Column B has a list of product names; and column D has amounts. e.g.

Column B Colomn D
(Product names) (Amounts)
--------------------------------
A 2
A 3
A 1
B 7
B 9
B 2
C 4
C 9

Etc.

What I need is a macro that will total the amounts per Product and if it is above 15 then move (or remove) those rows to a spreadsheet called "check".

If sounds simple enough doesn't it? But I just can't seem to get it to work.

Usually I would do it manually with a filter and then a sumproduct (and then cut / paste) but there are to many different product names to make this feasible.

If someone knows how to do this via a macro I would really really really appreciate it :)

Thanks ppl!
Steven123
This message was edited by Steven123 on 2002-09-27 08:45
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Jim North

MrExcel MVP
Joined
Jun 20, 2002
Messages
791
Hello Steven123,

You say "you can't get it to work"... do you have a macro started? If yes, post it to the board and we'll help you with it.
 

nick m

New Member
Joined
Sep 27, 2002
Messages
14
I am having the same problem can you please tell me how you overcame it.
the macro would be good to

Thank you
Nick
 

Steven123

New Member
Joined
Jun 19, 2002
Messages
18
I took a filter macro found on this board as the basis and added an IF / Then statement. (macro consists of a public sub and a funtion). I can't remember who built the filter part but all credit for that part goes to him (or her)!

What macro does is:
1) Filter column B
2) Sum totals in column D
3) If sum is smaller that 15 than delete those rows else go to the next filtered item.

The sum only adds up visible rows (which is all we want).


Sub Filter_Delete()

Dim rng As Range
Dim n As Long
Dim o As Long
Dim Waarde As Long
Dim Bereik As Range
Dim Bereik_Kolom As Range
Dim KeyKolom As Long
Dim WaardeKolom As Long
Dim HoofdWerkblad As Worksheet
Dim NieuwWerkboek As Workbook
Dim BereikCellen As Range

With ActiveSheet
If .AutoFilterMode Then
If .FilterMode Then .ShowAllData
Else
Selection.AutoFilter
End If
End With

Set HoofdWerkblad = ActiveSheet

On Error Resume Next

Set Bereik_Kolom = Columns("B:B")

KeyKolom = Bereik_Kolom.Column
WaardeKolom = KeyKolom - ActiveSheet.AutoFilter.Range.Column + 1

Set Bereik = ActiveSheet.AutoFilter.Range
Set Bereik = Bereik.Offset(1, WaardeKolom - 1).Resize(Bereik.Rows.Count - 1, 1)

Dim myarray As Variant
myarray = make_no_dupes(Bereik)

For Waarde = LBound(myarray) To UBound(myarray)

Selection.AutoFilter Field:=WaardeKolom, Criteria1:=myarray(Waarde)

Set rng = [D2:D65500].SpecialCells(xlCellTypeVisible)
n = Application.Sum(rng)

If n < 15 Then
rng.EntireRow.Delete
End If

Next Waarde

End Sub


Function make_no_dupes(inrange As Range) As Variant

Dim Waarde As Long
Dim myarray()
Dim mycell As Range

Dim nodupes As New Collection

On Error Resume Next
For Each mycell In inrange
nodupes.Add mycell.Value, CStr(mycell.Value)
Next mycell
On Error GoTo 0

ReDim myarray(1 To nodupes.Count)
For Waarde = 1 To nodupes.Count
myarray(Waarde) = nodupes.Item(Waarde)
Next Waarde
make_no_dupes = myarray

End Function
 

Forum statistics

Threads
1,144,766
Messages
5,726,170
Members
422,659
Latest member
RGP268

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top