Changing cell colour depending on content??

[Simon Lloyd]

Hi all, I am trying to get cells in a certain range to change colou
depending on their content, i need to check for a name and any othe
word in the cell i.e Cheryl Home where home could be a variable (als
it shouldnt matter what case it is in) then when it finds the name an
variable change the cells colour and leave only the variable visible i
the cell!

Here's what i have so far it doesn't quite work!
Dim mycell
Dim rng As Range
Set rng = Range("B4:M46")
For Each mycell In rng
If mycell = "" Then
Exit Sub
ElseIf mycell.Value = "Cheryl" & "*" Then
mycell.Select
End If
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
If mycell.Value = "Emma" & "*" Then
mycell.Select
End If
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
If mycell.Value = "Lauren" & "*" Then
mycell.Select
End If
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next

Hope you can help!

Reagrds
Simo

 

[Peter T]

One way -

Sub Test()
Dim mycell As Range
Dim rng As Range
Dim vaNames, vaColours
Dim i As Long, v 'As String

' perhaps a 2D array of cell values
vaNames = Array("Cheryl*", "Emma*", "Lauren*")
vaColours = Array(35, 36, 40)

' doesn't get text in formulas, could do without the specialcells
Set rng = Range("B4:M46").SpecialCells(xlCellTypeConstants, 2)

For Each mycell In rng
If Len(mycell.value) Then
v = mycell.Value
For i = 0 To UBound(vaNames)
If v Like vaNames(i) Then
mycell.Interior.ColorIndex = vaColours(i)
Exit For
End If
Next
End If
Next

End Sub

Regards,
Peter T

"Simon Lloyd" <[email protected]>
wrote in message
news:[email protected]...

 

[Dave Peterson]

Maybe...

Option Explicit
Sub testme()

Dim myCell as Range
Dim rng As Range
Set rng = Range("B4:M46")

For Each mycell In rng.cells
If mycell.value = "" Then
Exit Sub
elseif lcase(mycell.value) like Lcase("cheryl*") then
with mycell.interior
.ColorIndex = 35
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
elseif lcase(mycell.value) like lcase("Emma*") then
with mycell.interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
elseif lcase(mycell.value) like lcase("Lauren*") then
with mycell.interior
.ColorIndex = 40
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
end if
next mycell

end sub

But if you only have these 3 conditions, you may want to look at
Format|conditional formatting.

 

[Simon Lloyd]

Hi thanks for the replies!, Dave for some reason your code didnt work or
didnt appear to and Pete yours worked only if the text appeared as typed
in the code, however this shouldn't be a problem as the names are
selected from dropdowns.........what i really do need now is once the
colour has been put in place i need to loose the name but keep the
variable in the cell.
Could you help with that please?

Regards,
Simon

P.S Dave it must be something i have done for your code not to work as
you are usually spot on!

 

[Dave Peterson]

Your code stopped as soon as it hit an empty cell.

If you didn't want that, you could just use:

Option Explicit
Sub testme()

Dim myCell As Range
Dim rng As Range
Set rng = Range("B4:M46")
For Each myCell In rng.Cells
If LCase(myCell.Value) Like LCase("cheryl*") Then
With myCell.Interior
.ColorIndex = 35
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
ElseIf LCase(myCell.Value) Like LCase("Emma*") Then
With myCell.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
ElseIf LCase(myCell.Value) Like LCase("Lauren*") Then
With myCell.Interior
.ColorIndex = 40
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
Next myCell

End Sub

I don't understand what "lose the name, but keep the variable" means.

Maybe...

Option Explicit
Sub testme()

Dim myCell As Range
Dim rng As Range
Set rng = Range("B4:M46")
For Each myCell In rng.Cells
If LCase(myCell.Value) Like LCase("cheryl*") Then
With myCell.Interior
.ColorIndex = 35
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
myCell.Value = Mid(myCell.Value, Len("cheryl") + 1)
ElseIf LCase(myCell.Value) Like LCase("Emma*") Then
With myCell.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
myCell.Value = Mid(myCell.Value, Len("emma") + 1)
ElseIf LCase(myCell.Value) Like LCase("Lauren*") Then
With myCell.Interior
.ColorIndex = 40
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
myCell.Value = Mid(myCell.Value, Len("lauren") + 1)
End If
Next myCell

End Sub

==============

But Peter's code is more easily modified:

Option Explicit

Sub Test()
Dim mycell As Range
Dim rng As Range
Dim vaNames, vaColours
Dim i As Long, v 'As String

' perhaps a 2D array of cell values
vaNames = Array("Cheryl", "Emma", "Lauren")
vaColours = Array(35, 36, 40)

' doesn't get text in formulas, could do without the specialcells
Set rng = Range("B4:M46").cells

For Each mycell In rng
If Len(mycell.Value) Then
v = mycell.Value
For i = lbound(vaNames) To UBound(vaNames)
If LCase(v) Like LCase(vaNames(i)) & "*" Then
mycell.Interior.ColorIndex = vaColours(i)
mycell.Value = Mid(mycell.Value, Len(vaNames(i)) + 1)
'or to remove any leading spaces
mycell.Value = Trim(Mid(mycell.Value, Len(vaNames(i)) + 1))
End If
Next
End If
Next

End Sub

 

[Simon Lloyd]

Dave your quickly becoming a legend in my estimation!, your second code
that you provided that trimed the name off and left whatever else was
in the cell worked a treat, the modified version of Pete's code created
the colour and removed all of the contents of the cell.......so i'm
sticking with yours!

I must try to learn a little about searching or comparing text in any
case as excel always looks for exactly how you typed it in the code.

Thanks very much for your time and trouble!

Regards,
Simon

 

[Peter T]

the modified version of Pete's code created

the colour and removed all of the contents of the cell

Earlier you added to you original objective -
"what i really do need now is once the
colour has been put in place i need to loose the name but keep the
variable in the cell"

Dave suggested two different methods within the modified version to do just
that

mycell.Value = Mid(mycell.Value, Len(vaNames(i)) + 1)
'or to remove any leading spaces
mycell.Value = Trim(Mid(mycell.Value, Len(vaNames(i)) + 1)

I'm sure he didn't intend you to include both methods in the same code, but
for you to try each and use the one that best suits your needs, namely
delete the search string from the cell leaving other contents in place. Try
each with a comment in front of the other and take your pick. Altogether
Dave has given you lots of methods which is why he is indeed as you say a
legend <vbg>

Regards,
Peter


"Simon Lloyd" <[email protected]>
wrote in message

 

[Dave Peterson]

If I only had 2 or 3 names to check, I might use the "copy|paste" method of
writing code <bg>.

But if I had more (or might grow into more), I think your use of arrays is much
better.

Just add a couple things to a couple of arrays and walk away happy!