VBA summing values in column B grouping sums by value in column A saving values in column C

[dougkale]

I have a sheet that looks something like this:

A B
1 15
1 10
1 5
2 1
2 3
2 0

I want my result to look like:

A B C D
1 15 1 20
1 10 2 9
1 5
2 1
2 3
2 0


I do not know how many distinct values will be in column A and for each distinct value I do not know how many records will exist.

Any assistance will be greatly appreciated. I am trying scrub and balance some sheets within my group. This is the last step and while it seems simple I am not really sure how to approach it.

Thanks in advance

 

[dougkale]

I see my typo.

Should be:

A B C D
1 15 1 30
1 10 2 4
1 5
2 1
2 3
2 0

 

[Peter_SSs]

Welcome to the MrExcel board!

Try this.

Sub SumForUniqueValues()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    d(a(i, 1)) = d(a(i, 1)) + a(i, 2)
  Next i
  Range("C1:D1").Resize(d.Count).Value = Application.Transpose(Array(d.keys, d.items))
End Sub

Below, original data in cols A:B, result of code in C:D

Book1
	A	B	C	D
1	1	15	1	30
2	1	10	2	4
3	1	5
4	2	1
5	2	3
6	2	0
Sum

 

[dougkale]

Worked like a charm! Thank you so much for your help!

 

[Peter_SSs]

Worked like a charm! Thank you so much for your help!

You are welcome.

 

[dougkale]

OK, A similar problem, I actually thought the last solution could be easily modified to solve this but I am not figuring it out.

I have this:


M N O
----------------
1.5 c
2.5 d
3.0 d
4.0 c
1 d


and I want the result to be:


M N O
----------------
1.5 c
2.5 d
3.0 d
4.0 c
1 d

5.5 c
6.5 d
-1 t

I know where data in column M will begin but not where it will end.
Column N will only have c or d in it

Essentially I am trying to sum all of the c's and all of the d's (debits and credits) then subtract debits from credits.

I hope this makes sense.

 

[Peter_SSs]

Try this modification. I assumed data starts in row 2.

Sub DebitsAndCredits()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  d("c") = 0
  d("d") = 0
  a = Range("M2", Range("N" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    d(a(i, 2)) = d(a(i, 2)) + a(i, 1)
  Next i
  d("t") = d("c") - d("d")
  Range("M" & Rows.Count).End(xlUp).Offset(2).Resize(d.Count, 2).Value = Application.Transpose(Array(d.items, d.keys))
End Sub

 

[dougkale]

Odd results but getting close. Stepping through to figure it out.


M N O


20 1025478.51 C
53 443085.62 D
400 489817.56 C
500 1072210.45 D

0 c
0 d
0
20 1025478.51
53 443085.62
400 489817.56
500 1072210.45
0 t

 

[Peter_SSs]

What have you shown in post #8 ?
- Just some sample data?
- Sample data and actual results of the code?
- Sample data and expected results?
- Something else?

It is very hard to tell you have in what columns and rows. Any chance of posting some data like in post #3 where you can actually see where/how the data is laid out?

Do you actually have a mixture of upper and lower case "c" "C" etc? Your sample in post #6 was all lower case.

You have to make it very clear what you have (or can have) as well as what you expect (and where) otherwise we are continually left to guess.

 

[dougkale]

My apologies. Yes in this latest example I used actual data hoping it would make it more clear. I guess it was counter productive to the effort.

	M	N	O
3	20	1025479 <tbody> </tbody><colgroup><col></colgroup>	C
4	53	443085.6 <tbody> </tbody><colgroup><col></colgroup>	D
5	400	489817.6 <tbody> </tbody><colgroup><col></colgroup>	C
6	500	1072210 <tbody> </tbody><colgroup><col></colgroup>	D
7
8	0	C
9	0	D
10	20	1025479 <tbody> </tbody><colgroup><col></colgroup>
11	53	443085.6 <tbody> </tbody><colgroup><col></colgroup>
12	400	489817.6 <tbody> </tbody><colgroup><col></colgroup>
13	500	1072210 <tbody> </tbody><colgroup><col></colgroup>
14	0	T
15

<tbody>
</tbody>