Highlight matches to the current selected range cells

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,645
Office Version
  1. 2010
Platform
  1. Windows
Hello To All,</SPAN></SPAN>

Is it possible if I select the row 14, range A14:E14 and get highlighted all matched numbers are in columns as shown in example below.</SPAN>

ABCDE
1627303643
245151941
3330394041
4321343848
52813173844
6211132650
71329434750
81631323741
91222354649
10815172528
1124302636
121334374749
13511223440
14815263048

<TBODY>
</TBODY>


Thanks In Advance,</SPAN></SPAN>
Kishan</SPAN></SPAN>
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Try this:-
Code:
Private [COLOR=navy]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR=navy]As[/COLOR] Range)
[COLOR=navy]Dim[/COLOR] Rng         [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn          [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Col
[COLOR=navy]Dim[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range("A1:E14")
Rng.Interior.ColorIndex = xlNone
    [COLOR=navy]If[/COLOR] Not Intersect(Target, Rng) [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
        Col = Array(8, 6, 7, 5, 3)
            [COLOR=navy]For[/COLOR] Ac = 0 To UBound(Col) 
                [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
                    [COLOR=navy]If[/COLOR] Dn = Cells(Target.Row, Ac + 1) [COLOR=navy]Then[/COLOR]
                        Dn.Interior.ColorIndex = Col(Ac)
                    [COLOR=navy]End[/COLOR] If
                [COLOR=navy]Next[/COLOR] Dn
            [COLOR=navy]Next[/COLOR] Ac
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Thank you MikeG, for your help the code Worksheet_SelectionChange is giving perfect result as requested, but with this I cannot copy and paste any data in this sheet </SPAN></SPAN>

My new request is it possible?</SPAN></SPAN>
Can I select one or more cells to highlights match, for example instead of 5 cells in the row, if I select cell C14 (In this case highlights match only for number 26) and if I select C11 And D11 (In this case highlights match for number 30 and 26) my data range is in Cells A1:E3420 </SPAN></SPAN>

May be VBA solution that can highlights only the current selected cells match and refresh old one to normal after the each time code is perform.</SPAN></SPAN>

Please help and suggest better solution that you consider for this request</SPAN></SPAN>

Regards,</SPAN></SPAN>
Kishan</SPAN></SPAN>
 
Upvote 0
If you open the "ClipBoard" you can still copy and paste to it, Does that help or do you still want to have the code altered ???
 
Upvote 0
Thank you MickG, yes it helps <o:p></o:p>
<o:p></o:p>
But if it is not much trouble for you, could you alter the code as per my new request.<o:p></o:p>
That will be more useful for me<o:p></o:p>
<o:p></o:p>
I appreciate your help<o:p></o:p>
<o:p></o:p>
Regards,<o:p></o:p>
Kishan <o:p></o:p>
 
Upvote 0
Try this:-
Code:
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Col
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
Application.ScreenUpdating = False
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1:E3420")
Rng.Interior.ColorIndex = xlNone
    [COLOR="Navy"]If[/COLOR] Not Intersect(Target, Rng) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        Col = Array(8, 6, 7, 5, 3)
            [COLOR="Navy"]For[/COLOR] Ac = Target.Column - 1 To Target.Column + Target.Columns.count - 2
                [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                    [COLOR="Navy"]If[/COLOR] Dn = Cells(Target.Row, Ac + 1) [COLOR="Navy"]Then[/COLOR]
                        Dn.Interior.ColorIndex = Col(Ac)
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] Dn
            [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]End[/COLOR] If
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thank you MickG, It is amazing working, as I required</SPAN></SPAN>

Only copy and pasting bothering me much because I constant keep pasting data from other source, I think VBA solution may do not have this interruption.</SPAN></SPAN>

I appreciate all your help </SPAN></SPAN>

Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>
 
Upvote 0
You can run the code below (similar to other code) from the Macro Dialog box or a Command button, you just need to select the range (as previous code) before you run the code.
Then you wil be able to Cut & Paste.
Code:
[COLOR="Navy"]Sub[/COLOR] MG16Jun04
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Col
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
Application.ScreenUpdating = False
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1:E3420")
[COLOR="Navy"]If[/COLOR] Not Selection [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
Rng.Interior.ColorIndex = xlNone
    [COLOR="Navy"]If[/COLOR] Not Intersect(Selection, Rng) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        Col = Array(8, 6, 7, 5, 3)
            [COLOR="Navy"]For[/COLOR] Ac = Selection.Column - 1 To Selection.Column + Selection.Columns.count - 2
                [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                    [COLOR="Navy"]If[/COLOR] Dn = Cells(Selection.Row, Ac + 1) [COLOR="Navy"]Then[/COLOR]
                        Dn.Interior.ColorIndex = Col(Ac)
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] Dn
            [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thank you MickG, you are away someone</SPAN></SPAN>

I have to believe; it is working perfect no annoying at all.</SPAN></SPAN>

I am cheerful by your help </SPAN></SPAN>

Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top