Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 342
  • Last Modified:

Excel: set color of form based on value in cell

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
decisionfocus
Asked:
decisionfocus
  • 10
  • 6
  • 6
1 Solution
 
SiddharthRoutCommented:
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
 
decisionfocusAuthor Commented:
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
 
SiddharthRoutCommented:
But after copying the data into Rows 35:36, the values will change in every sheet?

Sid
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
SiddharthRoutCommented:
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
 
decisionfocusAuthor Commented:
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
 
SiddharthRoutCommented:
The code is almost ready :)

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

Sid
0
 
Rory ArchibaldCommented:
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
 
decisionfocusAuthor Commented:
Just to show my utter lack of comprehension; where would you put this code - in the Format sheet?
0
 
decisionfocusAuthor Commented:
Yes you would - it works perfectly :-)
0
 
SiddharthRoutCommented:
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
 
decisionfocusAuthor Commented:
Works like a charm! A great many thanks - you saved me countless hours of non-productive work - nd i even learned a bit :-)
0
 
SiddharthRoutCommented:
You are welcome :)

Sid
0
 
SiddharthRoutCommented:
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
 
Rory ArchibaldCommented:
Well, that was a good use of my time.
0
 
decisionfocusAuthor Commented:
@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
 
Rory ArchibaldCommented:
OK. :)
0
 
SiddharthRoutCommented:
>>>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
 
Rory ArchibaldCommented:
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
 
SiddharthRoutCommented:
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
 
Rory ArchibaldCommented:
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
 
SiddharthRoutCommented:
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
 
Rory ArchibaldCommented:
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

Ask an Anonymous Question!

Don't feel intimidated by what you don't know. Ask your question anonymously. It's easy! Learn more and upgrade.

  • 10
  • 6
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now