ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Conditional formating via VB (https://www.excelbanter.com/excel-programming/444287-conditional-formating-via-vbulletin.html)

Vacuum Sealed[_2_]

Conditional formating via VB
 
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[_2_]

Conditional formating via VB
 
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

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc



Vacuum Sealed[_2_]

Conditional formating via VB
 
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[_2_]

Conditional formating via VB
 
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

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc



Rick Rothstein

Conditional formating via VB
 
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[_2_]

Conditional formating via VB
 
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[_2_]

Conditional formating via VB
 
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

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc



GS[_2_]

Conditional formating via VB
 
on 2/25/2011, Vacuum Sealed supposed :
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

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc



Rick Rothstein

Conditional formating via VB
 
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"



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[_2_]

Conditional formating via VB
 
Rick Rothstein wrote on 2/25/2011 :
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"



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)


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

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc



GS[_2_]

Conditional formating via VB
 
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

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc



Vacuum Sealed[_2_]

Conditional formating via VB
 
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....:P

Thx heaps again to both of you.



Rick Rothstein

Conditional formating via VB
 
.... 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[_2_]

Conditional formating via VB
 
GS submitted this idea :
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


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

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc



GS[_2_]

Conditional formating via VB
 
Rick Rothstein wrote :
.... 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)


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

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc



GS[_2_]

Conditional formating via VB
 
Rick Rothstein was thinking very hard :
.... 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)


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

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc



Rick Rothstein

Conditional formating via VB
 
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[_2_]

Conditional formating via VB
 
Rick Rothstein used his keyboard to write :
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)


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

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc




All times are GMT +1. The time now is 11:50 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com