Sum column based on criteria vba

[Shaikh Aziz]

Please find below samples, where I want to do coding for rest of my actual data set,
ColumnA has multiple states name, ColumnB has unique values, and in columnC we want a sumif of columnB & Merging cells results based on states name (columnA).

ColumnA	ColumnB	ColumnC
Maharashtra	5​	25
Maharashtra	10​
Maharashtra	10​
Gujarat	30​	180
Gujarat	40​
Gujarat	50​
Gujarat	60​
Odisha	80​	313
Odisha	50​
Odisha	70​
Odisha	68​
Odisha	45​

Our result would be come in columnC after sum of ColumnB with mergecells based on columnA.

I have tried below codings,

Dim ColumnA as long
Dim ColumnC as long

ColumnsC = 0
ColumnA = Worksheets("Sheet1").Cells(2, 1).value

Lastrow = Worksheets("sheet1").cells(Rows.Count, 1).End(xlUp).Row

For i = 2 to lastrow
IF Worksheets("Sheet1").Cells(i, 1).value = ColumnA Then
ColumnC = ColumnC + Worksheets("Sheet1").cells(i, 3).value
End if
Next

worksheets("sheet1").cells(2, 3).value = ColumnC

But it's calcuating for columnA (first state only).

Please help me to finding perfect coding.
Thankyou !!!

 

[Shaikh Aziz]

You still need to tell us that you have posted to others sites. I suggest you read this to understand why. Excelguru Help Site - A message to forum cross posters

OK sir.

 

[Fluff]

How about

Sub ShaikhAziz()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, Rw As Long
   Dim Txt As String
   
   With Sheets("Sheet1")
      Ary = .Range("C2:N" & .Range("C" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 1)
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         Txt = Ary(r, 1) & "|" & Ary(r, 2)
         If Not .exists(Txt) Then
            .Add Txt, r
            Nary(r, 1) = Ary(r, 12)
         Else
            Rw = .Item(Txt)
            Nary(Rw, 1) = Nary(Rw, 1) + Ary(r, 12)
         End If
      Next r
   End With
   Sheets("sheet1").Range("O2").Resize(UBound(Nary)).Value = Nary
End Sub

 

[Shaikh Aziz]

How about

Sub ShaikhAziz()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, Rw As Long
   Dim Txt As String
  
   With Sheets("Sheet1")
      Ary = .Range("C2:N" & .Range("C" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 1)
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         Txt = Ary(r, 1) & "|" & Ary(r, 2)
         If Not .exists(Txt) Then
            .Add Txt, r
            Nary(r, 1) = Ary(r, 12)
         Else
            Rw = .Item(Txt)
            Nary(Rw, 1) = Nary(Rw, 1) + Ary(r, 12)
         End If
      Next r
   End With
   Sheets("sheet1").Range("O2").Resize(UBound(Nary)).Value = Nary
End Sub

Thankyou so much fluff,

Next time i will keep remember below 3 things,
1. i have to post exact columns
2. do not cross posting
3. i will asking only this board and you.

one day i wish i could be a coder like you...thankyou so much co-operating with me after all my stupid activities.

Have a good day sir !!! ?

 

[Fluff]

Glad to help & thanks for the feedback.

 

[Shaikh Aziz]

Glad to help & thanks for the feedback.

Dear Fluff, Hiii, Good morning,
Hope you doing well,

Below is one query, how to substract merged cells from ColumnO - ColumnK and result would be in ColumnP.

ColumnK	ColumnO	ColumnP
25	67
180	200
120	150
150	170

and result should be come in columnP as merged,

Thankyou in advance for help,

 

[Fluff]

I do not work with merged cells as they are an abomination.
You will need to start a new thread.

 

[Shaikh Aziz]

I do not work with merged cells as they are an abomination.
You will need to start a new thread.

okay sir sure. thankyou for revert.