Logo 
Search:

MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

User Input

  Asked By: Meenachi    Date: Dec 21    Category: MS Office    Views: 760
  

I'm using the following code to do conditional formatting and was wondering if I
can set up some user ones.

Dim rng As Range

Set rng = Intersect(Target, Range("A1:V22"))
If rng Is Nothing Then
Exit Sub
Else
Dim cl As Range
For Each cl In rng
Select Case cl.Text
Case ""
cl.Interior.ColorIndex = 0
Case "H"
cl.Interior.ColorIndex = 4
Case "HD"
cl.Interior.ColorIndex = 4
Case "S"
cl.Interior.ColorIndex = 3
Case "T"
cl.Interior.ColorIndex = 14
Case "TB"
cl.Interior.ColorIndex = 5
Case "C"
cl.Interior.ColorIndex = 7
Case "V"
cl.Interior.ColorIndex = 42
Case "M"
cl.Interior.ColorIndex = 44
Case "MD"
cl.Interior.ColorIndex = 43
Case "BH"
cl.Interior.ColorIndex = 47
Case "DS"
cl.Interior.ColorIndex = 23
Case Else
Exit Sub
End Select
Next cl
End If

End Sub


Can the color reference number be picked up by a cell value or even by a user
painting the cell what color they require? Also can the Case be user defined as
well?

Share: 

 

3 Answers Found

 
Answer #1    Answered By: Sage Anderson     Answered On: Dec 21

Anybody have any ideas for this please.....

 
Answer #2    Answered By: Khadeeja Malik     Answered 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

 
Answer #3    Answered By: Shayan Anderson     Answered On: Dec 21

I wrote a bit of code  to strip every other row on a sheet. It takes
color of a cell  to get the color  index number. Here is my code. Maybe
it will give an idea.

Private Sub ColorAlternateRows()
'
Dim myColor As Integer
Dim myColorPattern As Integer
Dim myColorRange As Range
Dim cell As Range
Dim myRange As Range

'This code should only run on the "Status" sheet
If ActiveSheet.Name <> Sheet2.Name Then End

'Set the variable "myColorRange" equal to the named worksheet range
that will contain the color
Set myColorRange = Range("Color_For_Status_Rows")

'Now put the "myColor" variable equal to the color index number  of the
cell
myColor = myColorRange.Interior.ColorIndex

'as well as the cell's pattern into the variable "myColorPattern".
myColorPattern = myColorRange.Interior.Pattern

'This for loop then colors the rows in the list based on if their row
number is odd or even. Pick a light color for the fill.
For Each cell In Range([a50000].End(xlUp), [a12]) 'establish the
used range below cell A12
If cell.Offset(0, 1) <> "N" Then
If cell.Row Mod 2 Then
Set myRange = Range(cell, cell.Offset(0,
Range("Status_Sheet_Comments").Offset(0, 7).Column))
myRange.Interior.ColorIndex = myColor
myRange.Interior.Pattern = myColorPattern
With myRange.EntireRow.Borders(xlEdgeBottom)
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Else
Set myRange = Range(cell, cell.Offset(0,
Range("Status_Sheet_Comments").Offset(0, 7).Column))
myRange.Interior.ColorIndex = xlNone
myRange.Interior.Pattern = 1
With myRange.EntireRow.Borders(xlEdgeBottom)
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
End If
Next
End Sub

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




Tagged: