VBA Highlight duplicate ID which sum of their value equal zero

[Aicha]

Dear Community
I need a formula that highlight values which total is zero but have the same reference ID
I want to have the below results.

[TABLE="width: 289"]
<colgroup><col span="2"><col></colgroup><tbody>[TR]
[TD]ID[/TD]
[TD]Value[/TD]
[TD]Result[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD="align: center"]1[/TD]
[TD]highlighted on color green[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD="align: center"]2[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD="align: center"]-1[/TD]
[TD]highlighted on color green[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD="align: center"]4[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD="align: center"]-2[/TD]
[TD]highlighted on color green[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD="align: center"]2[/TD]
[TD]highlighted on color green[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD="align: center"]3[/TD]
[TD="align: center"] [/TD]
[/TR]
</tbody>[/TABLE]

I will really appreciate if you can support
Thank you in advance.

 

[Akuini]

I don't quite understand the critria.
Let's say the data is below, is the result true?

Book1
	A	B	C
1	ID	Value	Result
2	A	1
3	A	1
4	A	-1
5	C	4
6	C	-2
7	C	-2
Sheet1

So id A won't be highlighted because the total isn't zero, but id C will be highlighted because the total is zero?

 

[Aicha]

Dear

Yes, exactly the result is true. I don't want want to use ABS because I could have different data for example A=3, A=-2, A=-1, these 3 items should be highlighted since total is zero and have the same reference ID. I think I will need a VBA code to solve this query.

 

[Akuini]

Ok, try this:

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1084377a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1084377-vba-highlight-duplicate-id-sum-their-value-equal-zero.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, x
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]

[COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
d.CompareMode = vbTextCompare
va = Range([COLOR=brown]"A1:B"[/COLOR] & Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp).Row)

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    x = Trim(va(i, [COLOR=crimson]1[/COLOR]))
        [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] d.Exists(x) [COLOR=Royalblue]Then[/COLOR]
            d(x) = va(i, [COLOR=crimson]2[/COLOR])
        [COLOR=Royalblue]Else[/COLOR]
            d(x) = d(x) + va(i, [COLOR=crimson]2[/COLOR])
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]Next[/COLOR]


Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    [I][COLOR=seagreen]'highlight in col C[/COLOR][/I]
    [COLOR=Royalblue]If[/COLOR] d(Trim(va(i, [COLOR=crimson]1[/COLOR]))) = [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]Then[/COLOR] Cells(i, [COLOR=brown]"C"[/COLOR]).Interior.Color = vbYellow
[COLOR=Royalblue]Next[/COLOR]
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[Aicha]

Hello,

You are genius, it's working but I don't understand why some items with the same reference ID wasn't highlighted while their total equal zero. I don't know why!!

 

[Akuini]

Hello,

You are genius, it's working but I don't understand why some items with the same reference ID wasn't highlighted while their total equal zero. I don't know why!!

Not sure why that happened.
Can you upload some sample where it went wrong?
Note: it's easier to check if you sort the data by ID first.
The code works for this made up sample:

Book1
	A	B	C
1	ID	VALUE	RESULT
2	J	-1
3	J	-1
4	K	-1
5	K	1
6	M	1
7	P	2
8	P	-3
9	P	1
10	Q	1
11	Q	2
12	R	-2
13	R	2
Sheet1

 

[Aicha]

Dear
Below is the link of an example of Data
https://drive.google.com/open?id=1yE1LTtWxMhU6rFwbL6vLIyNmU6AIykZR

Thank you

 

[Akuini]

Hm, your data in col B is Double type. Sometimes it is tricky to deal with, regarding the rounding issue.
So some of your data has total sum of 0 in the worksheet but when calculate it in vba it's not really 0, it's maybe 0,0000000001.
I don't how precise you want the calculation to be, but I revised the macro so if the sum is between -0.000001 and 0.000001 then it is considered 0.
Try this:

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1084377c()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1084377-vba-highlight-duplicate-id-sum-their-value-equal-zero.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, x
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]

[COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
d.CompareMode = vbTextCompare
va = Range([COLOR=brown]"A1:B"[/COLOR] & Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp).Row)
Columns([COLOR=brown]"C"[/COLOR]).Interior.Color = xlNone
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    x = Trim(va(i, [COLOR=crimson]1[/COLOR]))
        [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] d.Exists(x) [COLOR=Royalblue]Then[/COLOR]
            d(x) = va(i, [COLOR=crimson]2[/COLOR])
        [COLOR=Royalblue]Else[/COLOR]
            d(x) = d(x) + va(i, [COLOR=crimson]2[/COLOR])
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]Next[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    [I][COLOR=seagreen]'highlight in col C[/COLOR][/I]
    [COLOR=Royalblue]If[/COLOR] d(Trim(va(i, [COLOR=crimson]1[/COLOR]))) > -[COLOR=crimson]0.000001[/COLOR] [COLOR=Royalblue]And[/COLOR] d(Trim(va(i, [COLOR=crimson]1[/COLOR]))) < [COLOR=crimson]0.000001[/COLOR] [COLOR=Royalblue]Then[/COLOR] Cells(i, [COLOR=brown]"C"[/COLOR]).Interior.Color = vbYellow
[COLOR=Royalblue]Next[/COLOR]
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]