 |
| Excel VBA Discuss using VBA for Excel programming. |
Welcome to the p2p.wrox.com Forums.
You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
|
|
|
|

February 9th, 2009, 07:01 PM
|
|
Authorized User
|
|
Join Date: Feb 2009
Posts: 25
Thanks: 11
Thanked 0 Times in 0 Posts
|
|
Background color in a range of cells
Hello, I am just learning VBA for Excel.
Where I work, we have a daily roster sheet for keeping up with who is present, who is "ill", who is on vacation, etc.
The employee name, rank, days off, work status, and work location are the columns (C-G). If a person's works status is, say, "ill", then the entire line (C-G) gets colored green, "vacation" is pink, and so forth. There are about 6 different colors so this can't be done entirely by using conditional formatting (it only allows 3).
There are six sheets in the workbook for 6 different locations.
I can make the active cell change color by using the Workbook_SheetChange procedure, but can't make it color the entire row (C-G). Any suggestions?
|
|

February 10th, 2009, 02:07 AM
|
|
Friend of Wrox
|
|
Join Date: Sep 2005
Posts: 812
Thanks: 1
Thanked 53 Times in 49 Posts
|
|
You can try extending that as follows
Code:
Sub Color_C2G()
Dim iRow As Long
iRow = ActiveCell.Row
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.ColorIndex = 36
End Sub
Cheers
Shasur
|
|
The Following User Says Thank You to Shasur For This Useful Post:
|
|
|

February 10th, 2009, 09:11 PM
|
|
Authorized User
|
|
Join Date: Feb 2009
Posts: 25
Thanks: 11
Thanked 0 Times in 0 Posts
|
|
Background color in a range of cells
This is how I get the activecell to change color. Where would I put the code you suggested?
code:
Private Sub Workbook_SheetChange(ByVal sh As Object, _
ByVal Source As range)
sh.Activate
If (sh.range(Source.Address).Text = "I") Then
Source.Interior.ColorIndex = 4
ElseIf (sh.range(Source.Address).Text = "B") Then
Source.Interior.ColorIndex = 4
ElseIf (sh.range(Source.Address).Text = "F") Then
Source.Interior.ColorIndex = 4
ElseIf (sh.range(Source.Address).Text = "RDO") Then
Source.Interior.ColorIndex = 6
ElseIf (sh.range(Source.Address).Text = "H") Then
Source.Interior.ColorIndex = 37
ElseIf (sh.range(Source.Address).Text = "G") Then
Source.Interior.ColorIndex = 37
ElseIf (sh.range(Source.Address).Text = "A") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "S/A") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "M") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "MIL") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "A/S") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "J/S") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "J") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "TRN") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "I/S") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "V/S") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "DCCT") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "X") Then
Source.Interior.ColorIndex = 45
ElseIf (sh.range(Source.Address).Text = "V") Then
Source.Interior.ColorIndex = 38
ElseIf (sh.range(Source.Address).Text = "C") Then
Source.Interior.ColorIndex = 39
ElseIf (sh.range(Source.Address).Text = "Y") Then
Source.Interior.ColorIndex = 39
Else
Source.Interior.Color = vbWhite
End If
End Sub
/code
|
|

February 11th, 2009, 01:24 AM
|
|
Friend of Wrox
|
|
Join Date: Sep 2005
Posts: 812
Thanks: 1
Thanked 53 Times in 49 Posts
|
|
Can you try this:
Code:
Private Sub Workbook_SheetChange(ByVal sh As Object, _
ByVal Source As Range)
sh.Activate
Dim iRow As Long
iRow = Source.Row
If (sh.Range(Source.Address).Text = "I") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 4
ElseIf (sh.Range(Source.Address).Text = "B") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 4
ElseIf (sh.Range(Source.Address).Text = "F") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 4
ElseIf (sh.Range(Source.Address).Text = "RDO") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 6
ElseIf (sh.Range(Source.Address).Text = "H") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 37
ElseIf (sh.Range(Source.Address).Text = "G") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 37
ElseIf (sh.Range(Source.Address).Text = "A") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "S/A") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "M") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "MIL") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "A/S") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "J/S") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "J") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "TRN") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "I/S") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "V/S") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "DCCT") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "X") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
ElseIf (sh.Range(Source.Address).Text = "V") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 38
ElseIf (sh.Range(Source.Address).Text = "C") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 39
ElseIf (sh.Range(Source.Address).Text = "Y") Then
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 39
Else
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = vbWhite
End If
End Sub
Cheers
Shasur
|
|
The Following User Says Thank You to Shasur For This Useful Post:
|
|
|

February 11th, 2009, 11:30 AM
|
|
Authorized User
|
|
Join Date: Feb 2009
Posts: 25
Thanks: 11
Thanked 0 Times in 0 Posts
|
|
Background color in a range of cells
I made on little modification. The numbers in my code are ColorIndex, not color! Worked like a charm. Thanks Shasur. I've added you to my "buddy list!"
|
|

February 13th, 2009, 06:05 AM
|
|
Registered User
|
|
Join Date: Jan 2009
Posts: 8
Thanks: 0
Thanked 2 Times in 2 Posts
|
|
You might find the "Select Case" statement simpler to work with:
Code:
Select Case sh.Range(Source.Address).Text
Case "I", "B", "F"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 4
Case "RDO"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 6
Case "H", "G"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 37
Case "A", "S/A", "M", "MIL", "A/S", "J/S", "J", "TRN", "I/S", "V/S", "DCCT", "X"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 45
Case "V"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 38
Case "C", "Y"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = 39
Case Else
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = vbWhite
End Select
Also, I wonder if the default case else should be:
Code:
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.Color = xlNone
|
|
The Following User Says Thank You to tomj54 For This Useful Post:
|
|
|

February 13th, 2009, 08:47 PM
|
|
Authorized User
|
|
Join Date: Feb 2009
Posts: 25
Thanks: 11
Thanked 0 Times in 0 Posts
|
|
Background color in a range of cells
That sure makes the code simpler to write. Actually, those numbers are ColorIndex instead of Color, and I've since changed the last line to ColorIndex = 0
How does this Case thing work, anyway?
|
|

February 14th, 2009, 08:07 AM
|
|
Registered User
|
|
Join Date: Jan 2009
Posts: 8
Thanks: 0
Thanked 2 Times in 2 Posts
|
|
1) You are correct: the range of values you are using is more suitable for .ColorIndex property.
.Color property can be used with RGB values (e.g. RGB (255,00,00)) , or convert to decimal ( 16711680), or use a vb constants (e.g. vbRed).
.Color property will always result in same color.
.ColorIndex property results will vary depending on particular color palette currently in use.
Use whichever best suits your purpose.
2) In your example, simply replace the if..then..elsif..endif statement construction:
Code:
Private Sub Workbook_SheetChange(ByVal sh As Object, _
ByVal Source As Range)
sh.Activate
Dim iRow As Long
iRow = Source.Row
Select Case sh.Range(Source.Address).Text
Case "I", "B", "F"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.ColorIndex = 4
Case "RDO"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.ColorIndex = 6
Case "H", "G"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.ColorIndex = 37
Case "A", "S/A", "M", "MIL", "A/S", "J/S", "J", "TRN", "I/S", "V/S", "DCCT", "X"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.ColorIndex = 45
Case "V"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.ColorIndex = 38
Case "C", "Y"
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.ColorIndex = 39
Case Else
Range(Cells(iRow, 3), Cells(iRow, 8)).Interior.ColorIndex = xlNone
End Select
End Sub
The Case function interprets the test expression (e.g. sh.Range(Source.Address).Text), then executes only the first Case clause (e.g. "V") that matches test expression value (so order of clauses can be significant). Else clause is optional, although I always use it to insure logical excluded middle.
What's particularly nice, is that Case is so flexible. You can use multiple expressions or ranges in each Case clause. For example:
Code:
Case 1 To 4, 7 To 9, 11, 13, Is > MaxNumber
You can nest Case statements and construct readable, complex clauses:
Code:
Select Case Number
Case 1
Select Case Another
Case âOneâ
Result = âOneâ
If Something = SomethingElse Then
PerformSub
Endif
Case âTwoâ
Result = âTwoâ
Case Else
Result = âN/Aâ
End Select
Case 2
Result = 2
Case Else
Result = 0
End Select
And you can test unrelated conditions:
Code:
Select Case True
Case Today = "Mon", "Tue", "Wed", "Thu", "Fri"
Result = GoToWork
Case Month >= 5 and Month < 9
Result = WearWhiteShoes
Case Apples# <> Oranges#
Result = DontBeSurprised
Case Else
Exit Sub
End Select
|
|
The Following User Says Thank You to tomj54 For This Useful Post:
|
|
|

February 21st, 2009, 06:19 PM
|
|
Authorized User
|
|
Join Date: Feb 2009
Posts: 25
Thanks: 11
Thanked 0 Times in 0 Posts
|
|
Background color in a range of cells
Well, here I am, back again. This select.case thing seems to remove formatting in some cells I don't want it to. Also, with the source as range, if I put some of the letters, "I","B","A", etc in other cells, it also colors the range. In my sheet, the "F" column, or column 6 is the only one that I want to color the range. Reason being, in column 7, or "Location" column, some of the assignments are "B", "A". If someone is at work, but assigned to "A" or "B" then the row is colored in. I don't want it to do that.
This is probably clear as mud. If someone wants, I can email them the sheet so it will be more plain what I'm talking about.
Thanks in advance for your help.
Last edited by billy1r; February 21st, 2009 at 08:07 PM..
|
|

February 23rd, 2009, 11:45 PM
|
|
Authorized User
|
|
Join Date: Nov 2007
Posts: 48
Thanks: 0
Thanked 4 Times in 4 Posts
|
|
billy1r,
I sent your updated workbook back - "Copy_of_Floor_Rosters_02-21-09 - Billy Redus - SDG.xls".
Please follow the instructions in the e-mail, and on sheet "4th Floor".
You want to delete your original "This Workbook" Event code.
You want to copy the "Worksheet_Change" Event code in this worksheet, sheet "4th Floor" to each of the other worksheets.
NOT into the "This Workbook" "Microsoft Excel Objects".
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim iRow As Long
iRow = Target.Row
Target = UCase(Target.Text)
Select Case UCase(Target.Text)
Case "I", "B", "F"
Range(Cells(iRow, 3), Cells(iRow, 7)).Interior.ColorIndex = 4
Case "RDO"
Range(Cells(iRow, 3), Cells(iRow, 7)).Interior.ColorIndex = 6
Case "H", "G"
Range(Cells(iRow, 3), Cells(iRow, 7)).Interior.ColorIndex = 37
Case "A", "S/A", "M", "MIL", "A/S", "J/S", "J", "TRN", "I/S", "V/S", "DCCT", "X"
Range(Cells(iRow, 3), Cells(iRow, 7)).Interior.ColorIndex = 45
Case "V"
Range(Cells(iRow, 3), Cells(iRow, 7)).Interior.ColorIndex = 38
Case "C", "Y"
Range(Cells(iRow, 3), Cells(iRow, 7)).Interior.ColorIndex = 39
Case Else
Range(Cells(iRow, 3), Cells(iRow, 7)).Interior.ColorIndex = xlNone
End Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Have a great day,
Stan
__________________
stanleydgromjr
Windows 8.1, Excel 2007.
|
|
The Following User Says Thank You to stanleydgromjr For This Useful Post:
|
|
|
 |