Solved

Excel 2003: Using a formula to copy formatting (ie: background colour)

Posted on 2010-11-25
7
615 Views
Last Modified: 2012-05-10
Hey there - Conditional Formatting is not cutting it for me right now because of the 3 conditions limit. I would like to shy away from a VB=based solution, because:
A) I don't want any issues when sharing my worksheet
B) I don't want to have to run a macro each time I change a value

Essentially what I'm hoping I can do is:
- On Worksheet A, put a different background colour in each cell (A1..A5)
- On Worksheet B, I have a formula in a cell that looks at the number in that cell (1 to 5) and based on that number, use the colour from the corresponding cell in Worksheet A
- eg: in Worksheet B, if I put a "2" in the cell, it will fill that cell with the colour found in WorksheetA:A2; if I put a "5" in the cell, it will fill the cell with the colour from WorksheetA:A5.

The problem is, I haven't found any functions in Excel that deal with the formatting of a cell, as opposed to the data.

Please bear in mind this is Excel 2003, so I can't use conditional formatting, since I need more than 3 different colours.

Thanks for you advice!
0
Comment
Question by:tomaugerdotcom
  • 4
  • 3
7 Comments
 
LVL 50

Expert Comment

by:teylyn
ID: 34214182
Hello,

there is no way to do what you describe with formulas. Conditional formatting is the only way to change cell formatting on the fly. Anything that goes beyond that will need to use VBA.

cheers, teylyn
0
 
LVL 14

Author Comment

by:tomaugerdotcom
ID: 34214190
Dang. Okay, so what would a VBA solution look like? And would it be automatic or would you have to push a button to make it update?

T
0
 
LVL 50

Expert Comment

by:teylyn
ID: 34214256
There are many ways to do this. It really depends on your requirements. The code below monitors column A. When any value from 1-5 is entered into column A, the cell will automatically turn one of five pre-defined colors.

The code goes into the sheet module (right-click the sheet tab, select View Code and paste code into the code window)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
If Not Intersect(Target, Range("A:A")) Is Nothing Then
For Each cel In Target
    Select Case cel.Value
        Case 1
            With cel.Interior
                .ColorIndex = 43
                .Pattern = xlSolid
            End With
        Case 2
            With cel.Interior
                .ColorIndex = 8
                .Pattern = xlSolid
            End With
        Case 3
            With cel.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
            End With
        Case 4
            With cel.Interior
                .ColorIndex = 53
                .Pattern = xlSolid
            End With
        Case 5
            With cel.Interior
                .ColorIndex = 55
                .Pattern = xlSolid
            End With
        Case Else
            cel.Interior.ColorIndex = xlNone
    End Select
Next cel
End If
End Sub

Open in new window


cheers, teylyn
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 14

Author Comment

by:tomaugerdotcom
ID: 34214467
Right on - thanks for this. Could you show me how to read the ColorIndex of a particular cell, rather than arbitrarily defining it within the code?


PS: Lol - VB is such a crappy language. This syntax: "If Not Intersect(Target, Range("A:A")) Is Nothing Then" is outrageous!

 
0
 
LVL 50

Accepted Solution

by:
teylyn earned 500 total points
ID: 34214728
Try this: On Sheet2, format cells A1 to A5 with the color of your choice.

Then plug this macro into Sheet1 and enter numbers into column A

Note that this is not dynamic, i.e. if you change the colors on Sheet2, only the cells changed after that will be affected. Cells already colored will keep their color. To apply the new color to all present cells, copy the cells and paste them again onto themselves. This will trigger the change event and the new colors will be applied.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
If Not Intersect(Target, Range("A:A")) Is Nothing Then
For Each cel In Target
    Select Case cel.Value
        Case 1
            With cel.Interior
                .ColorIndex = ActiveWorkbook.Worksheets("Sheet2").Range("A1").Interior.ColorIndex
                .Pattern = xlSolid
            End With
        Case 2
            With cel.Interior
                .ColorIndex = ActiveWorkbook.Worksheets("Sheet2").Range("A2").Interior.ColorIndex
                .Pattern = xlSolid
            End With
        Case 3
            With cel.Interior
                .ColorIndex = ActiveWorkbook.Worksheets("Sheet2").Range("A3").Interior.ColorIndex
                .Pattern = xlSolid
            End With
        Case 4
            With cel.Interior
                .ColorIndex = ActiveWorkbook.Worksheets("Sheet2").Range("A4").Interior.ColorIndex
                .Pattern = xlSolid
            End With
        Case 5
            With cel.Interior
                .ColorIndex = ActiveWorkbook.Worksheets("Sheet2").Range("A5").Interior.ColorIndex
                .Pattern = xlSolid
            End With
        Case Else
            cel.Interior.ColorIndex = xlNone
    End Select
Next cel
End If
End Sub

Open in new window


cheers, teylyn
0
 
LVL 14

Author Comment

by:tomaugerdotcom
ID: 34218650
Outstanding, Teylyn - thanks so much for providing this excellent help. You really put me on the right track with this - and I like how it still pretty much updates automatically, so long as you don't mess with the colour codes.

I have improved on your code by making it more parametrized, and opening it up to using the full A:Z range of the worksheet. For anyone else wanting to use this code, you must name the worksheet that contains the colour reference "Colour Codes" (note the Canadian spelling!! hehe).

Well done and thanks.

-- Tom
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
    If Not Intersect(Target, Range("A:Z")) Is Nothing Then
        For Each cel In Target
            With cel.Interior
                .ColorIndex = ActiveWorkbook.Worksheets("Colour Codes").Cells(cel.Value, 1).Interior.ColorIndex
                .Pattern = xlSolid
            End With
        Next cel
    End If
End Sub

Open in new window

0
 
LVL 14

Author Closing Comment

by:tomaugerdotcom
ID: 34218651
Thanks for taking the time and for providing working code.
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

746 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

10 Experts available now in Live!

Get 1:1 Help Now