# Highlight matches to the current selected range cells

#### Kishan

##### Well-known Member
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>

 A B C D E 1 6 27 30 36 43 2 4 5 15 19 41 3 3 30 39 40 41 4 3 21 34 38 48 5 28 13 17 38 44 6 2 11 13 26 50 7 13 29 43 47 50 8 16 31 32 37 41 9 12 22 35 46 49 10 8 15 17 25 28 11 2 4 30 26 36 12 13 34 37 47 49 13 5 11 22 34 40 14 8 15 26 30 48

<TBODY>
</TBODY>

Kishan</SPAN></SPAN>

### Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
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:
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>

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 ???

Thank you MickG, yes it helps <o></o>
<o></o>
But if it is not much trouble for you, could you alter the code as per my new request.<o></o>
That will be more useful for me<o></o>
<o></o>
I appreciate your help<o></o>
<o></o>
Regards,<o></o>
Kishan <o></o>

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

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>

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

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>

Thanks for the feedback
Regards Mick

Replies
2
Views
499
Replies
5
Views
500
Replies
1
Views
367
Replies
4
Views
595
Replies
4
Views
1K

1,196,467
Messages
6,015,403
Members
441,892
Latest member
gpen

### 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?

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