To find out same positive & negative values in given column - Macro Code Request

[harinsh]

Hi Team,

Can anyone please help me with below requirement and please provide macro code??

I need macro where it has to find out same values negative & positive values and it should get highlight with some color and if once it's matches the minus (-) & plus (+) same values then that macro should not search same values again (already highlighted)

Example: In below example we can see ABCD & LLLPP has 10.000 positive & negative values. Hence automatically macro should identify these fields and it's should get highlight and same number should ignore for further steps.

Desc Amount
ABCD 10,000.00
ABCE 80,000.00
XXXP 93,000.00
XXPP 45,000.00
LLLPP (10,000.00)
OOOP 89,000.00
YIUIO 35,000.00
QWER (45,000.00)
HJKHJ (80,000.00)


Kindly let us know if you require further clarification and please do the needful.

Thanks in advance.

Thanks,
Hari

 

[harinsh]

Thanks Mick

 

[harinsh]

Hi Mick,

I need another confirmation from you is it possible to change code as per below requirement? As I inserted column 'C' and values between Column B & C should get validate and get highlighted if same values (negative & positive).

[TABLE="width: 199"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Desc[/TD]
[TD]Amount[/TD]
[TD]Amt2[/TD]
[/TR]
[TR]
[TD]ABCD[/TD]
[TD="align: right"]10,000.00[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]ABCE[/TD]
[TD="align: right"]80,000.00[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]XXXP[/TD]
[TD="align: right"]93,000.00[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]XXPP[/TD]
[TD="align: right"]45,000.00[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]LLLP[/TD]
[TD] [/TD]
[TD="align: right"]-10,000.00[/TD]
[/TR]
[TR]
[TD]OOOP[/TD]
[TD="align: right"]89,000.00[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]YIUI[/TD]
[TD="align: right"]35,000.00[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]QWER[/TD]
[TD] [/TD]
[TD="align: right"]-45,000.00[/TD]
[/TR]
[TR]
[TD]HJKH[/TD]
[TD] [/TD]
[TD="align: right"]-80,000.00[/TD]
[/TR]
</tbody>[/TABLE]

Please do the needful.

Thanks,
Harish

 

[MickG]

Try this:-

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] RngB [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] RngC [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rb [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rc      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dc      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Col
[COLOR="Navy"]Dim[/COLOR] Ac      [COLOR="Navy"]As[/COLOR] Byte
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Dim[/COLOR] K
[COLOR="Navy"]Dim[/COLOR] oMin    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] b       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]If[/COLOR] Not Intersect(Target, Columns("B:C")) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] RngB = Range(Range("B2"), Range("B" & Rows.count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] RngC = Range(Range("C2"), Range("C" & Rows.count).End(xlUp))
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
Col = Array(RngB, RngC)
    [COLOR="Navy"]For[/COLOR] Ac = 0 To 1
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Col(Ac)
            [COLOR="Navy"]If[/COLOR] Not .Exists(Abs(Dn.Value)) [COLOR="Navy"]Then[/COLOR]
                .Add Abs(Dn.Value), Array(Dn, Dc)
            [COLOR="Navy"]Else[/COLOR]
                Q = .Item(Abs(Dn.Value))
                    [COLOR="Navy"]If[/COLOR] Ac = 0 [COLOR="Navy"]Then[/COLOR]
                        [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
                    [COLOR="Navy"]Else[/COLOR]
                        [COLOR="Navy"]If[/COLOR] Q(1) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                            [COLOR="Navy"]Set[/COLOR] Q(1) = Dn
                        [COLOR="Navy"]Else[/COLOR]
                            [COLOR="Navy"]Set[/COLOR] Q(1) = Union(Q(1), Dn)
                        [COLOR="Navy"]End[/COLOR] If
                    [COLOR="Navy"]End[/COLOR] If
                .Item(Abs(Dn.Value)) = Q
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]Next[/COLOR] Ac

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .Keys
    [COLOR="Navy"]If[/COLOR] Not .Item(K)(0) [COLOR="Navy"]Is[/COLOR] Nothing And Not .Item(K)(1) [COLOR="Navy"]Is[/COLOR] Nothing And Not K = 0 [COLOR="Navy"]Then[/COLOR]
        oMin = Application.Min(.Item(K)(0).count, .Item(K)(1).count)
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rb [COLOR="Navy"]In[/COLOR] .Item(K)(0)
                b = b + 1
                Rb.Interior.ColorIndex = 6
                [COLOR="Navy"]If[/COLOR] b = oMin [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] For
            [COLOR="Navy"]Next[/COLOR] Rb
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rc [COLOR="Navy"]In[/COLOR] .Item(K)(1)
                c = c + 1
                Rc.Interior.ColorIndex = 6
                [COLOR="Navy"]If[/COLOR] c = oMin [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] For
            [COLOR="Navy"]Next[/COLOR] Rc
        c = 0: b = 0
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[CosmicSnake]

Try:-

[COLOR=Navy]Sub[/COLOR] MG07Jul24
[COLOR=Navy]Dim[/COLOR] rng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] rng = Range(Range("B2"), Range("B" & Rows.count).End(xlUp))
    [COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] rng
    [COLOR=Navy]If[/COLOR] Not .Exists(Abs(Dn.Value)) [COLOR=Navy]Then[/COLOR]
        .Add Abs(Dn.Value), Dn
    [COLOR=Navy]Else[/COLOR]
        [COLOR=Navy]If[/COLOR] .Item(Abs(Dn.Value)).count = 1 And .Item(Abs(Dn.Value)) + Dn.Value = 0 [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]Set[/COLOR] .Item(Abs(Dn.Value)) = Union(.Item(Abs(Dn.Value)), Dn)
            .Item(Abs(Dn.Value)).Font.ColorIndex = 3
         [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Hi guys, sorry to bother you in such old topic. But i have a doubt as i'm such beginner with Macros.

So basically i've used macro provided earlier in this topic, but i still need one adition.

When the same number appears for a few times, just one selection (one positive and one negative) happens. Is it possible to have the other selections added to this macro? (check image below)



Thanks in advance!