Find The Sum Of Unique Values In A Selected Range

Excel VBA Sum Unique Values

      In this study, we have the worksheet that it has 9 columns .

We created  an Excel VBA code to sum the values of unique items in column B. Ago we listed cells in "column B" as unique values  into column "K" (we listed unique values in the column B into column K) :
Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Columns( _
        "B:B"), CopyToRange:=Range("'Example1'!K1"), Unique:=True

Later  we entered the formulas with a loop to sum these items into column "L" :
For i = 2 To Cells(Rows.Count, 11).End(xlUp).Row
       Cells(i, "L").FormulaR1C1 = "=SUMIF(C[-10],RC[-1],C[-3])"
Next i

For this purpose we created different two macros :

Macro 1 In The Example1 Sheet :

Macro 2 In The Example2 Sheet :

On the Example2 sheet, we found the sum of the unique values by creating a pivot table :
Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(9), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Application.DisplayAlerts = True

We entered formulas into cells by a loop to get subtotal in column "I". We highlighted the cells that they contains formula (cells that show subtotal) by this loop :
For Each rng In Range("I2:I" & Cells(Rows.Count, 9).End(xlUp).Row)
If rng.HasFormula Then
With rng
.Interior.ColorIndex = 37
.Font.Bold = True
End With
End If

No comments:

Post a Comment