CODEWITHSUNDEEP
excelvba
the_new_guy
the_new_guy

Reputation: 197

How to get the sum of total for each category in excel using VBA?

I have a excel document which has 14 rows. I need to calculate total per each category using VBA.

enter image description here

I have attached dummy data. I need to find the total of Approx_Fees_in_USD for each distinct value in the column workstream i.e Total Approx_fees_in_USD for indirect tax,Direct tax, Statutory reporting etc using VBA. Any help is appreciated.

Thanks.

Here is the modified code.

Public Sub summary()
 

  Dim sh As Worksheet, dict As Object: Set dict = CreateObject("Scripting.Dictionary")
  Dim lastRow As Long, arr As Variant, i As Long, key As Variant
  
  Sheets("Sheet1").Range("D:D").Copy Sheets("Sheet2").Range("A:A")
  Sheets("Sheet1").Range("N:N").Copy Sheets("Sheet2").Range("B:B")
  Range("D1").Value = "Workstream"
  Range("E1").Value = "Total Fees per Workstream"
   
  Worksheets("Sheet2").Activate
  Set sh = Sheets("Sheet2")
  lastRow = sh.Range("A" & Rows.Count).End(xlUp).row
  arr = sh.Range("A2:B" & lastRow).Value
  
  For i = 1 To UBound(arr, 1)
    If Not dict.Exists(arr(i, 1)) Then
        dict.Add key:=arr(i, 1), Item:=arr(i, 11) 'Subscript out of range
    Else
        dict(arr(i, 1)) = dict(arr(i, 1)) + arr(i, 11)
    End If
  Next i
  i = 2
  For Each key In dict
    sh.Range("D" & i).Value = key
    sh.Range("E" & i).Value = dict(key)
    i = i + 1
  Next
  
  
End Sub

Upvotes: 0

Views: 902

Answers (1)

FaneDuru
FaneDuru

Reputation: 42246

Try the next code, please. It returns the result in columns "O:P".

It needs a reference to 'Microsoft Scripting Runtime'. If you do not know how to add such a reference, I will show you. If you prefer without a reference, I will adapt the code to work without it:

Sub TotalPerCategory()
  Dim sh As Worksheet, dict As New Scripting.Dictionary
  Dim lastRow As Long, arr As Variant, i As Long, key As Variant
  
  Set sh = ActiveSheet
  lastRow = sh.Range("A" & Rows.Count).End(xlUp).row
  arr = sh.Range("A2:B" & lastRow).Value
  
  For i = 1 To UBound(arr, 1)
    If Not dict.Exists(arr(i, 1)) Then
        dict.aDD key:=arr(i, 1), Item:=arr(i, 2)
    Else
        dict(arr(i, 1)) = dict(arr(i, 1)) + arr(i, 2)
    End If
  Next i
  i = 2
  For Each key In dict
     sh.Range("C" & i).Value = key
     sh.Range("D" & i).Value = dict(key)
     i = i + 1
  Next
End Sub

In order to avoid the reference, please delete/comment the line:

'Dim sh As Worksheet, dict As New Scripting.Dictionary

and use:

Dim sh As Worksheet, dict As Object: Set dict = CreateObject("Scripting.Dictionary")

Edited: I adapted the code to process the range "A2:N" & lastRow as you requested.

Upvotes: 3

Related Questions