VBA for custom subtotal based on conditions

[willow1985]

Hello,

I am making a Macro to clean up some data but one task that has always eluded me was an efficient method to subtotal quantities based on conditions (See example below).

I have used subtotal previously but it only allows one condition (as far as I am aware) and can be slow depending on the volume of data.

What I want to do is take the "BEFORE" data and have a macro clean up the data including Subtotaling the Qty for every Same Part number with the Same condition.
so Every Throttle Shaft who's part number is 2543391 and has a condition of NE, subtotal Qty onto one line.

Is there a way to do this that wont bog down excel too much? (I could have 10000 rows of data).

Thank you to anyone who can help

 

[ranman256]

have you tried an Excel query , sum on Qty.

 

[Fluff]

How about

Sub willow()
   Dim Ary As Variant
   Dim Dic As Object
   Dim i As Long
   Dim Tmp As String
   
   Set Dic = CreateObject("scripting.dictionary")
   Ary = Range("A1").CurrentRegion.Value2
   
   For i = 2 To UBound(Ary)
      Tmp = Ary(i, 1) & "|" & Ary(i, 2) & "|" & Ary(i, 3)
      Dic(Tmp) = Dic(Tmp) + Ary(i, 4)
   Next i
   
   With Range("G2").Resize(Dic.Count)
      .Value = Application.Transpose(Dic.Keys)
      .TextToColumns Range("G2"), xlDelimited, xlTextQualifierDoubleQuote, , 0, 0, 0, 0, 1, "|"
      .Offset(, 3).Value = Application.Transpose(Dic.Items)
   End With

 

[LannyN]

Forgive if this is a newbie response, but what about using the SumIfs function?

 

[willow1985]

This works perfect. Instead of having the results in column G is it possible to have it go into another sheet at A1? (We will call it Sheet2 for this example)

 

[willow1985]

I don't see how to use the SumIFs function accurately since I want to remove the duplicated rows. Fluff Macro works however I just need to put the data on another sheet instead of the same sheet. I also need to keep the headers...

 

[LannyN]

I just finished a subroutine that copied all of the projected invoice dates for product and installation service charges in a column (with duplicates) onto a "data" sheet where I remove the duplicates, blank lines (because I grabbed all of the values in a column). I then format, sort and use the sumif to roll up the amounts to be invoiced by date. The result is being placed onto a Summary sheet with rolled up data that will serve as an "executive summary" for those who don't like all of the detail on the main sheet. Still working on the latter at the moment, but it is coming together.

 

[Fluff]

How about

Sub willow()
   Dim Ary As Variant
   Dim Dic As Object
   Dim i As Long
   Dim Tmp As String
   
   Set Dic = CreateObject("scripting.dictionary")
   Ary = Range("A1").CurrentRegion.Value2
   
   For i = 1 To UBound(Ary)
      Tmp = Ary(i, 1) & "|" & Ary(i, 2) & "|" & Ary(i, 3)
      Dic(Tmp) = Dic(Tmp) + Ary(i, 4)
   Next i
   
   With Sheets("Sheet2").Range("A1").Resize(Dic.Count)
      .Value = Application.Transpose(Dic.Keys)
      .TextToColumns Range("A1"), xlDelimited, xlTextQualifierDoubleQuote, , 0, 0, 0, 0, 1, "|"
      .Offset(, 3).Value = Application.Transpose(Dic.Items)
   End With
End Sub

 

[willow1985]

This VBA code is perfect! Thank you very much!

 

[willow1985]

I just finished a subroutine that copied all of the projected invoice dates for product and installation service charges in a column (with duplicates) onto a "data" sheet where I remove the duplicates, blank lines (because I grabbed all of the values in a column). I then format, sort and use the sumif to roll up the amounts to be invoiced by date. The result is being placed onto a Summary sheet with rolled up data that will serve as an "executive summary" for those who don't like all of the detail on the main sheet. Still working on the latter at the moment, but it is coming together.

I think I understand what you are saying. That is a good method as well. I will keep that in mind.

Thank you very much