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

 

[JLGWhiz]

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

This procedure assumes the data is in sheet1, Columns A and B. Adjust the code accordingly.

Code:
Sub normal()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range, fVal As Range
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = sh.Range("B2:B" & lr)
For Each c In rng
If Not c Is Nothing Then
If c.Font.ColorIndex = -4105 Then
x = c.Value * (-1)
Set fVal = sh.Range("B" & c.Row + 1 & ":B" & lr).Find(x, LookIn:=xlValues)
If Not fVal Is Nothing Then
c.Offset(0, -1).Resize(1, 2).Interior.ColorIndex = 6
fVal.Offset(0, -1).Resize(1, 2).Interior.ColorIndex = 6
End If
End If
End If
Next
End Sub
Code:

 

[MickG]

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

 

[harinsh]

Hi Mick,

Many Thanks for your code is working fine.....you really superb!!!! I will check this macro with my original data and will find out results.

Have a great day

Warm regards,
Hari

 

[harinsh]

Hi JLGWhiz

Thanks for your code, but I can see that macro running but no color highlighting for those values. But macro which Mick has provided is working fine.

Thanks for your time and reply.

Warm regards.
Hari

 

[Marcelo Branco]

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 Mick,

Nice code!

Let me ask:
this code line
.Add Abs(Dn.Value), Dn
is setting a range (an object) as an Item of the dictionary?

I didn't know such was possible.

Regards,

M.

 

[harinsh]

Hello Mick,

What would be the code if macro should get highlight in lBackground color. I think only changes required in this line....

.Item(Abs(Dn.Value)).Font.ColorIndex = 3

Thanks
Warm regards,
Hari
[TABLE="width: 143"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Thanks for the Feedback.

Harish.
You should be able to change that line to the below

.Item(Abs(Dn.Value)).interior.ColorIndex = 3

Marcelo,
Yes, Thats correct, there is a lot of potential in a dictionary for doing this sort of thing.

Regards Mick

 

[Marcelo Branco]

Marcelo,
Yes, Thats correct, there is a lot of potential in a dictionary for doing this sort of thing.

Regards Mick

Yes, i can see!

So you can use the methods and properties of the object as you did in
If .Item(Abs(Dn.Value)).count = 1

wow.. this really has a lot of potential as you said. Good to know and thanks for your reply.

M.

 

[MickG]

Pleasure.
Mick