Conditional formating via VB

[Vacuum Sealed]

Hi all

Was wondering if anyone could correct the following so that it actually
works please..


Private Sub Worksheet_Change(ByVal Target As Range)

Dim MyRowRange As Range

Set MyRowRange = ("A:N")

If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then


Select Case True

Case Target.Value = "RESTRICTED"

MyRowRange.BackColor = RED

Case Target.Value = "FULL ACCESS"

MyRowRange.BackColor= LIGHT GREEN

Case Target.Value = "LIMITED"

MyRowRange.BackColor= YELLOW

End Select

End If
End Sub

Essential when the sole user of this sheet selects a security access level
for staff members I would like it to color the background of MyRowRange to
the applicable color for that specific row that is being intersected with/by
the column "M".

I know I can do this via the Ribbon, but it will not be available to the
user as he will only have File|Open|Close|Exit|Save available at this stage.

TIA
Mick

 

[GS]

Try this...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRowRange As Range
Set MyRowRange = ("A:N")

If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then
With MyRowRange
Select Case Target.Value
Case "RESTRICTED": .BackColor = RED
Case "FULL ACCESS": .BackColor= LIGHT GREEN
Case "LIMITED": .BackColor= YELLOW
End Select '//Case Target.Value
End With '//MyRowRange
End If '//Not Intersect
End Sub

 

[Vacuum Sealed]

Hi there Garry

And thank you for your ongoing help.

The code halted on:

Set MyRowRange = ("A:N")


would it be better to use the FormatR1C1 and have something like:

Set MyRowRange = (C[1], C[14])

or something along those lines

Cheers
Mick

 

[GS]

Vacuum Sealed formulated on Friday :

Hi there Garry

And thank you for your ongoing help.

The code halted on:

Set MyRowRange = ("A:N")


would it be better to use the FormatR1C1 and have something like:

Set MyRowRange = (C[1], C[14])

or something along those lines

Cheers
Mick

Saorry about that! I didn't go past correcting the Select Case
construct. Here's a tested version...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRowRange As Range
Set MyRowRange = ActiveSheet.Range("A:N")

If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then
With MyRowRange.Interior
Select Case Target.Value
Case "RESTRICTED": .ColorIndex = 3 '//red
Case "FULL ACCESS": .ColorIndex = 35 '//light green
Case "LIMITED": .ColorIndex = 6 '//yellow
Case Else: .ColorIndex = 0 '//no fill
End Select '//Case Target.Value
End With '//MyRowRange.Interior
End If '//Not Intersect
End Sub

 

[Rick Rothstein]

Saorry about that! I didn't go past correcting the Select Case

construct.Here 's a tested version...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRowRange As Range
Set MyRowRange = ActiveSheet.Range("A:N")

If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then
With MyRowRange.Interior
Select Case Target.Value
Case "RESTRICTED": .ColorIndex = 3 '//red
Case "FULL ACCESS": .ColorIndex = 35 '//light green
Case "LIMITED": .ColorIndex = 6 '//yellow
Case Else: .ColorIndex = 0 '//no fill
End Select '//Case Target.Value
End With '//MyRowRange.Interior
End If '//Not Intersect
End Sub

@Garry,

You need to change your With statement from this...

With MyRowRange.Interior

to this...

With Intersect(MyRowRange, Target.EntireRow).Interior

because the OP, in his original message, said "I would like it to color the
background of MyRowRange to the applicable color for that specific row that
is being intersected with/by the column "M"

Rick Rothstein (MVP - Excel)

 

[Vacuum Sealed]

Thank you to both

That works great.

I truly love coming here as with each visit I learn something new and
helpful...

Appreciate your time.

Regards
Mick

 

[GS]

Rick Rothstein presented the following explanation :

@Garry,

You need to change your With statement from this...

With MyRowRange.Interior

to this...

With Intersect(MyRowRange, Target.EntireRow).Interior

because the OP, in his original message, said "I would like it to color the
background of MyRowRange to the applicable color for that specific row that
is being intersected with/by the column "M"

Rick Rothstein (MVP - Excel)

Yes, thanks for pointing that out. I did miss this important detail.
Here's the revised proc...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRowRange As Range

Set MyRowRange = ActiveSheet.Range("A:N")
If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then
With Intersect(MyRowRange, Target.EntireRow).Interior
Select Case Target.Value
Case "RESTRICTED": .ColorIndex = 3 '//red
Case "FULL ACCESS": .ColorIndex = 35 '//light green
Case "LIMITED": .ColorIndex = 6 '//yellow
Case Else: .ColorIndex = 0 '//no fill
End Select '//Case Target.Value
End With '//MyRowRange.Interior
End If '//Not Intersect
End Sub

 

[GS]

Thank you to both

That works great.

I truly love coming here as with each visit I learn something new and
helpful...

Appreciate your time.

Regards
Mick

Glad to help! Glad for Rick's help too!<g>

 

[Rick Rothstein]

You need to change your With statement from this...

Yes, thanks for pointing that out. I did miss this important detail.
Here 's the revised proc...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRowRange As Range

Set MyRowRange = ActiveSheet.Range("A:N")
If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then
With Intersect(MyRowRange, Target.EntireRow).Interior
Select Case Target.Value
Case "RESTRICTED": .ColorIndex = 3 '//red
Case "FULL ACCESS": .ColorIndex = 35 '//light green
Case "LIMITED": .ColorIndex = 6 '//yellow
Case Else: .ColorIndex = 0 '//no fill
End Select '//Case Target.Value
End With '//MyRowRange.Interior
End If '//Not Intersect
End Sub

@Garry,

Would you like to see the functionality of your code reduced to a one-liner
(albeit, a long one)?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then Range("A" & _
Target.Row).Resize(1, 14).Interior.ColorIndex = CLng(Split("3 35 6") _
(InStr(1, "RESTRICTED ,FULL ACCESS,LIMITED ", Target.Value, 1) \ 11))
End Sub

@Mick,

Do not even consider for a minute using this code in your actual program...
I just developed it for fun, not for actual use... it would be a nightmare
to maintain.

Rick Rothstein (MVP - Excel)

 

[GS]

Rick Rothstein wrote on 2/25/2011 :

@Garry,

Would you like to see the functionality of your code reduced to a one-liner
(albeit, a long one)?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then Range("A" & _
Target.Row).Resize(1, 14).Interior.ColorIndex = CLng(Split("3 35 6") _
(InStr(1, "RESTRICTED ,FULL ACCESS,LIMITED ", Target.Value, 1) \ 11))
End Sub

@Mick,

Do not even consider for a minute using this code in your actual program... I
just developed it for fun, not for actual use... it would be a nightmare to
maintain.

Rick Rothstein (MVP - Excel)

Awesome, awesome, and awesome! It doesn't handle if the value is
cleared, though. (Range turns red)

 

[GS]

GS has brought this to us :

Awesome, awesome, and awesome! It doesn't handle if the value is cleared,
though. (Range turns red)

@Rick,
Here's my fix...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then _
Range("A" & Target.Row).Resize(1, 14).Interior.ColorIndex = _
CLng(Split("0 3 35 6") _
(InStr(1, " ,RESTRICTED ,FULL ACCESS,LIMITED ", _
Target.Value, 1) \ 12))
End Sub

 

[Vacuum Sealed]

Rick

Strange things are born from tiny Things / Ideas such as this.

Once the Library is developed to handle it, it would be so cool to reduce
complex multi-lined codes to a single.

I like to consider I think outside the square as its always fun, al-be-it
somewhat frustrating at times....

Thx heaps again to both of you.

 

[Rick Rothstein]

.... It doesn't handle if the value is cleared, though. (Range turns red)

Good point. We can handle this problem, still with a one-liner, but the code
has gotten a little longer...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then Range("A" _
& Target.Row).Resize(1, 14).Interior.ColorIndex = Split("0 3 35 6") _
(InStr(1, " ,RESTRICTED ,FULL ACCESS,LIMITED ", Format( _
Target.Value & " ", "!@@@@@@@@@@@"), 1) \ 11)
End Sub

Rick Rothstein (MVP - Excel)

 

[GS]

GS submitted this idea :

GS has brought this to us :

@Rick,
Here's my fix...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then _
Range("A" & Target.Row).Resize(1, 14).Interior.ColorIndex = _
CLng(Split("0 3 35 6") _
(InStr(1, " ,RESTRICTED ,FULL ACCESS,LIMITED ", _
Target.Value, 1) \ 12))
End Sub

Interestingly, I was playing around with the length of each component
of the InStr string, and I forgot to return the divisor to 11. It still
works as expected with 12 but that's just not correct. So.., change
last line to...

Target.Value, 1) \ 11))

 

[GS]

Rick Rothstein wrote :

Good point. We can handle this problem, still with a one-liner, but the code
has gotten a little longer...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then Range("A" _
& Target.Row).Resize(1, 14).Interior.ColorIndex = Split("0 3 35 6") _
(InStr(1, " ,RESTRICTED ,FULL ACCESS,LIMITED ", Format( _
Target.Value & " ", "!@@@@@@@@@@@"), 1) \ 11)
End Sub

Rick Rothstein (MVP - Excel)

Rick, see my fix. It doesn't require Format() <IMO>!

 

[GS]

Rick Rothstein was thinking very hard :

Good point. We can handle this problem, still with a one-liner, but the code
has gotten a little longer...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M6:M3000")) Is Nothing Then Range("A" _
& Target.Row).Resize(1, 14).Interior.ColorIndex = Split("0 3 35 6") _
(InStr(1, " ,RESTRICTED ,FULL ACCESS,LIMITED ", Format( _
Target.Value & " ", "!@@@@@@@@@@@"), 1) \ 11)
End Sub

Rick Rothstein (MVP - Excel)

"FULL ACCESS" clears the fill. Removing the Format() makes it work as
expected.

 

[Rick Rothstein]

Rick, see my fix. It doesn't require Format() <IMO>!

You are right... the Format function call is not required. I had made an
error, wrote code (incorrectly) to correct the problem, then modified that
and ended up posting it in haste without testing it. Anyway, I am glad you
were able to follow my logic and make the correction on your own... good
job. Now, let's make it into what I consider a "true" one-liner and remove
the If..Then housing...

Private Sub Worksheet_Change(ByVal Target As Range)
Range("A" & Target.Row).Resize(1, 14).Interior.ColorIndex = Split( _
"0 3 35 6")(-(Not Intersect(Target, Range("M6:M3000")) Is Nothing) * _
(InStr(1, " ,RESTRICTED ,FULL ACCESS,LIMITED ", _
Target.Value, 1) \ 11))
End Sub

Note that I constructed the InStr function (originally and now still) to
allow the words to be typed with any letter casing on the assumption the
user is typing the words in and might type Limited instead of LIMITED.
However, if data validation is being used on the cells in Column M so that
the casing will always be upper case, then we can shorten the code
slightly....

Private Sub Worksheet_Change(ByVal Target As Range)
Range("A" & Target.Row).Resize(1, 14).Interior.ColorIndex = Split( _
"0 3 35 6")(-(Not Intersect(Target, Range("M6:M3000")) Is Nothing) * _
(InStr(" ,RESTRICTED ,FULL ACCESS,LIMITED ", _
Target.Value) \ 11))
End Sub

Rick Rothstein (MVP - Excel)

 

[GS]

Rick Rothstein used his keyboard to write :

You are right... the Format function call is not required. I had made an
error, wrote code (incorrectly) to correct the problem, then modified that
and ended up posting it in haste without testing it. Anyway, I am glad you
were able to follow my logic and make the correction on your own... good job.
Now, let's make it into what I consider a "true" one-liner and remove the
If..Then housing...

Private Sub Worksheet_Change(ByVal Target As Range)
Range("A" & Target.Row).Resize(1, 14).Interior.ColorIndex = Split( _
"0 3 35 6")(-(Not Intersect(Target, Range("M6:M3000")) Is Nothing) * _
(InStr(1, " ,RESTRICTED ,FULL ACCESS,LIMITED ", _
Target.Value, 1) \ 11))
End Sub

Note that I constructed the InStr function (originally and now still) to
allow the words to be typed with any letter casing on the assumption the user
is typing the words in and might type Limited instead of LIMITED. However, if
data validation is being used on the cells in Column M so that the casing
will always be upper case, then we can shorten the code slightly....

Private Sub Worksheet_Change(ByVal Target As Range)
Range("A" & Target.Row).Resize(1, 14).Interior.ColorIndex = Split( _
"0 3 35 6")(-(Not Intersect(Target, Range("M6:M3000")) Is Nothing) * _
(InStr(" ,RESTRICTED ,FULL ACCESS,LIMITED ", _
Target.Value) \ 11))
End Sub

Rick Rothstein (MVP - Excel)

Good job, Rick! Either one looks great to me. Personally, I prefer non
case sensitive. Thanks for the exercise, ..I appreciate your persistant
effort!