excel vba code for complicated filtering - excel

Question

I have the following dataset:
Name Code Output Type
Alice Apple -100 B
Alice Apple +60 S
Alice Banana -52 S
Alice Apple +40 S
Alice mango -5000 S
Bob Kiwi -500 B
Bob Kiwi +500 S
Bob peach -40 S
Dan Banana -50 S
Dan peach +28 S
I want to reduce this data using the following criteria:
IF records with a given name do not contain "B" in any record in column "Type" then I don't want to consider it. So the "Dan" records are out. Of the 5 Alice records, the first one has a "Type" "B" and Bob has a "Type" "B" as well.
For others, I want to see which fruit numbers don't net out to zero.
So this is what I would like to see:
Name Code output Type
Alice Banana -52 S
Alice mango -5000 S
Bob peach -40 S
Right now, First I am doing a SumIfs over Name and Code.
=SUMIFS($C$2:$C$21,$B$2:$B$21,B2,$A$2:$A$21,A2)
Then I create a column where I give the value 1 when type = B and 0 otherwise.
=IF(D2="B",1,0)
Then I am doing a Sumif to figure out which names have a "B"
=SUMIF($A$2:$A$21,A2,$F$2:$F$21)
Then I will filter the ones which don't have a B and where the SUMIFS are not zero.
Right now this is in-sheet. I intend to use these formula in a VBA macro. Is there a better way to do this? Say without creating new columns?

Answer 1

Assuming your columns are in the correct order as above. the below code will generate a new 5th column with 0, 1.
Option Explicit
Option Compare Text
Sub SetFilter()
Dim sh As Worksheet: Set sh = Sheet1
' YOU MUST add reference "Microsoft Scripting Runtime" from tools menu to use this object...
Dim FruitSums As New Scripting.Dictionary ' key = name of fruit, value is running total
FruitSums.CompareMode = TextCompare
Dim iR As Integer
Dim lbl As String
Dim value As Variant
'get fruit sums
For iR = 2 To sh.UsedRange.Rows.Count
lbl = sh.Cells(iR, 2)
value = sh.Cells(iR, 3)
If IsNumeric(value) Then
If FruitSums.Exists(lbl) Then
FruitSums(lbl) = FruitSums(lbl) + CLng(value)
Else
FruitSums(lbl) = CLng(value)
End If
End If
Next
' calculate the filter column
For iR = 2 To sh.UsedRange.Rows.Count
If sh.Cells(iR, 4) = "B" Then
sh.Cells(iR, 5) = 1 ' ok, is a B
Else
lbl = sh.Cells(iR, 2)
If FruitSums.Exists(lbl) Then
If CLng(FruitSums(lbl)) = 0 Then
sh.Cells(iR, 5) = 0 ' not ok, is total 0
Else
sh.Cells(iR, 5) = 1 ' ok, is not 0
End If
Else ' this case should not occur
sh.Cells(iR, 5) = -1 ' unexpected output.
End If
End If
Next
End Sub