Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Meenachi Suppiah   on Dec 21 In MS Office Category.

  
Question Answered By: Khadeeja Malik   on Dec 21

This might do it for you. set  up an area, away from the nitty gritty
of the sheet, where the user  can enter into each cell  some text and
colour the cell as he wants it to be coloured. The way I've done it
(using CurrentRegion) the area must be bounded by any combination of
blank rows and blank columns (or the edge of the sheet). This is what
becomes the look-up table. If you use a single column, or single row
there must not be any blank cells among them. The B25 in the code  is
just one cell that I chose to be definitely within that range. You can
define that range any way you want if you choose not to use CurrentRegion.

Later in the code I used Find which sets mycell to a range (one cell)
if found and uses the colour of that cell to colour the newly changed
cell in A1:V22.

I've made it case  sensitive as your code is.

By the way, if the user copies a block of cells, your code would stop
colouring cells at the first encounter of a non-match, due to the Exit
Sub immediately after the Case Else. I don't think you want it to be
there.

If you have Option Explicit at the top of the code module you may have
to add some Dim statements.

I've assumed this was in a Worksheet_Change event.

Private Sub Worksheet_Change(ByVal Target As Range)
Set rng = Intersect(Target, Range("A1:V22"))
If Not rng Is Nothing Then
Set lookuptable = Range("B25").CurrentRegion
For Each cll In rng.Cells
Set mycell = lookuptable.Find(cll.Value, LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=True)
If Not mycell Is Nothing Then
cll.Interior.ColorIndex = mycell.Interior.ColorIndex
End If
Next cll
End If
End Sub

If you want non-matches and deleted values to revert to Excel's
default background colour then add an Else statement thus:

Private Sub Worksheet_Change(ByVal Target As Range)
Set rng = Intersect(Target, Range("A1:V22"))
If Not rng Is Nothing Then
Set lookuptable = Range("B25").CurrentRegion
For Each cll In rng.Cells
Set mycell = lookuptable.Find(cll.Value, LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=True)
If Not mycell Is Nothing Then
cll.Interior.ColorIndex = mycell.Interior.ColorIndex
Else
cll.Interior.ColorIndex = xlNone
End If
Next cll
End If
End Sub

Share: 

 

This Question has 2 more answer(s). View Complete Question Thread

 
Didn't find what you were looking for? Find more on User Input Or get search suggestion and latest updates.


Tagged: