Solved

Excel: set color of form based on value in cell

Posted on 2011-03-22
22
333 Views
Last Modified: 2012-08-13
Hi,

The sheet "Format" in the attached workbook contains 6 forms (block arrows) that symbolizes Project phases in a project management model. The forms have been named "Fase_1", Fase_2" [....] "Fase_6".

I need to color them either blue or yellow based on the content of a cell (the same blue & yellow as used as an example in the sheet)

For Fase_1
if C36=Analysis
Fase_1.Color = Blue
else Fase_1.Color=Yellow

For Fase_2
if C36=Project Preparation & Planning
Fase_2.Color = Blue
else Fase_2.Color=Yellow

For Fase_3
if C36=Work In Progress & Executing
Fase_3.Color = Blue
else Fase_3.Color=Yellow

For Fase_4
if C36=Test & Approval
Fase_4.Color = Blue
else Fase_4.Color=Yellow

For Fase_5
if C36=Implementation & Controlling
Fase_5.Color = Blue
else Fase_5.Color=Yellow

For Fase_6
if C36=Closing & Follo-up
Fase_6.Color = Blue
else Fase_6.Color=Yellow

IF C36 isempty
All Forms.Color = Yellow

Hope you guys are able to help out a bit :-)

Br Jonas







Solar-Weekly-0.3.xls
0
Comment
Question by:decisionfocus
  • 10
  • 6
  • 6
22 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35187173
Br Jonas: This is further to your previous post. Do you want to format the "Format Sheet" or the sheet which is finally copied?

Sid
0
 

Author Comment

by:decisionfocus
ID: 35187183
I think the "Format" sheet. The formatting should then carry into the copied sheets and i'd be able to use the code from your previous post unmodified.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35187190
But after copying the data into Rows 35:36, the values will change in every sheet?

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35187193
My suggestion: Let the format sheet be as it is. After the new sheet is created, we check the values in that sheet and then color the shapes?

Sid
0
 

Author Comment

by:decisionfocus
ID: 35187204
The content of the C36 cell will actually be different in each sheet as each sheet represents different projects that can be in different phases - and should thus have different coloring of the forms (the blue form representing the actual phase of the project).

However - i'm so far out of my depth here that we'll of course go with your suggestion!

Br Jonas
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35187214
The code is almost ready :)

Quick question: Do you want to fill the color or color the borders of the shape?

Sid
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35187252
Basic code in the worksheet change event:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rng As Range
   Dim n As Long
   Dim varCodes, varShapes
   Application.ScreenUpdating = False
   varCodes = Array("Analysis", "Project Preparation & Planning", "Work In Progress & Executing", "Test & Approval", "Implementation & Controlling", "Closing & Follow-up")
   varShapes = Array("Fase_1", "Fase_2", "Fase_3", "Fase_4", "Fase_5", "Fase_6")
   Set rng = Range("C36")
   If Not Intersect(Target, rng) Is Nothing Then
      For n = LBound(varCodes) To UBound(varCodes)
         With Me.Shapes(varShapes(n)).Fill
            .Visible = msoTrue
            .Solid
            If StrComp(rng.Value, varCodes(n), vbTextCompare) = 0 Then
               .ForeColor.RGB = vbBlue
            Else
               Me.Shapes(varShapes(n)).Fill.ForeColor.RGB = vbYellow
            End If
         End With
      Next n
   End If
   Application.ScreenUpdating = True

End Sub

Open in new window


for example
0
 

Author Comment

by:decisionfocus
ID: 35187432
Just to show my utter lack of comprehension; where would you put this code - in the Format sheet?
0
 

Author Comment

by:decisionfocus
ID: 35187470
Yes you would - it works perfectly :-)
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 500 total points
ID: 35187556
UNTESTED

Ok. I have incorporated the code with your previous code :)

It will color the shapes as it creates the sheets. Let me know if you get any errors. Replace the code Sample with the code in the module.

Sid

Sub Sample()
    Dim i As Long, LastRow As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim shp As Shape
    
    On Error GoTo Whoa
    
    Application.ScreenUpdating = False
    
    Set ws1 = Sheets("Data Input")
    
    LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
    
    Sheets("Format").Visible = True
    
    For i = 2 To LastRow
        Sheets("Format").Copy After:=Sheets(Sheets.Count)
        Set ws2 = ActiveSheet
        ws2.Name = ws1.Range("B" & i).Value
        ws1.Range("A" & i & ":X" & i).Copy _
        ws2.Range("A36:X36")
        ws2.Rows("35:36").EntireRow.Hidden = True
        
        For Each shp In ws2.Shapes
            If shp.Name = "Fase_1" Or shp.Name = "Fase_2" Or shp.Name = "Fase_3" Or _
               shp.Name = "Fase_4" Or shp.Name = "Fase_5" Or shp.Name = "Fase_6" Then
                shp.Fill.ForeColor.RGB = vbYellow
            End If
        Next
        
        Select Case ws2.Range("c36").Value
        
        Case "Analysis"
            ws2.Shapes("Fase_1").Fill.ForeColor.RGB = vbBlue
        Case "Project Preparation & Planning"
            ws2.Shapes("Fase_2").Fill.ForeColor.RGB = vbBlue
        Case "Work In Progress & Executing"
            ws2.Shapes("Fase_3").Fill.ForeColor.RGB = vbBlue
        Case "Test & Approval"
            ws2.Shapes("Fase_4").Fill.ForeColor.RGB = vbBlue
        Case "Implementation & Controlling"
            ws2.Shapes("Fase_5").Fill.ForeColor.RGB = vbBlue
        Case "Closing & Follo-up"
            ws2.Shapes("Fase_6").Fill.ForeColor.RGB = vbBlue
        Case ""
            For Each shp In ws2.Shapes
                If shp.Name = "Fase_1" Or shp.Name = "Fase_2" Or shp.Name = "Fase_3" Or _
                   shp.Name = "Fase_4" Or shp.Name = "Fase_5" Or shp.Name = "Fase_6" Then
                    shp.Fill.ForeColor.RGB = vbWhite
                End If
            Next
        End Select
    Next i
LetsContinue:
    Sheets("Format").Visible = False
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Open in new window

0
 

Author Closing Comment

by:decisionfocus
ID: 35187579
Works like a charm! A great many thanks - you saved me countless hours of non-productive work - nd i even learned a bit :-)
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35187581
You are welcome :)

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35187628
You Excel file reminds on the Green Belt 6 Sigma project that I did :)

I had DMAIC instead of those values.

One more suggestion. If you manually color the shapes yellow in the format sheet then you don't need to color them in the code. Do you think that might help?

Sid
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35187742
Well, that was a good use of my time.
0
 

Author Comment

by:decisionfocus
ID: 35187800
@SiddharthRout: followed your suggestion, works perfectly

@rorya: I apologize - i was so caught up in this that i didn't actually see that another user than SiddharthRout came up with a suggestion - sorry about that!
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35187806
OK. :)
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35187811
>>>followed your suggestion, works perfectly

Gr8

>>>i was so caught up in this that i didn't actually see that another user
If you want you may click on request attention to re-open the thread and reassign the points. It is okay with me. :)

@Rorya: In this particular example, it is co-related with the previous question. And hence the worksheet change event wouldn't have helped :)

Sid
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35187853
No need to reopen - an honest mistake is no problem.

Sid,
Since you are altering the values on the sheet, I don't see why a change event wouldn't work, but it's moot anyway. ;)
Rory
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35187855
Ah! Ok. Seems like you missed the first 5 posts. The entire idea was to format the newly created output sheets and not the "Format" sheet.

Sid
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35187875
Understood, but you are copying the Format sheet, so the change event will go with it, and you are changing the value of C26 on the copy, so why wouldn't it work? (it would also then recolour if you changed the values later)
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35187892
Yes, but wouldn't that copy Sheets with the 'CODE'. So if there are 50 rows in the data sheet then it will create 50 copies of the format sheet with codes?

Sid
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35187901
Yes, it would. Nothing to indicate that's a problem that I can see. Anyway, as I said, it's moot so we can leave it there.
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now