VBA code for a timeline chart (lookalike)

[K. Georgiadis]

I posted this in the "Charting" newsgroup but, since it
is not truly a chart, I thought I'd also post it here:

As I stated in my previous post, my VBA skills are
rudimentary but I ordered J. Walkenbach's "VBA for Excel"
and I am hoping to learn a little more over the next few
weeks.
Meanwhile, can anyone point me in the right direction
with the VBA code needed to color cells a certain color,
depending on the corresponding cell content of another
worksheet:

Namely;
1) Worksheet 1 has a matrix with years running across the
top and product names running down column A.
2) Intersecting cells contain four (4) key words: EX, FS,
GE, or RE
3) the same matrix is copied over to a new worksheet 2
but, instead of keywords, I now simply want to shade the
cells different colors, depending on the keywords
contained in the parent sheet: maroon if cell content
is "EX," red if cell content is "GE," blue if cell
content is "RE" and green if cell content is "FS."

The intent is to create a worksheet that looks like a
timeline chart

 

[Otto Moehrbach]

If those cells will always have one of those four entries, you can use
Conditional Formatting with one of those colors being the default. Look it
up in Help for details. HTH Otto

 

[K. Georgiadis]

I guess I don't know how to do this; I want the cells to
be white unless one of the other four conditions are met.
Doesn't that require 4 conditions, one more than
Conditional Formatting will accomodate?

 

[Otto Moehrbach]

The first macro below will do what you want given what you said you have.
You can use numbers for the colors if you wish. The second macro below
generates a color index chart on the active sheet. Run this second macro
with a blank sheet active. HTH Otto

Sub ChangeColor()
Dim Cell As Range
Dim RngToCheck As Range
With Sheets("Second")
Set RngToCheck = .Range("A1", .Range(.UsedRange.Address))
End With
For Each Cell In RngToCheck
With Sheets("Parent")
Select Case .Range(Cell.Address).Value
Case "EX"
Cell.Interior.Color = 18
Case "FS"
Cell.Interior.Color = vbGreen
Case "GE"
Cell.Interior.Color = vbRed
Case "RE"
Cell.Interior.Color = vbBlue
Case Else
Cell.Interior.Color = vbWhite
End Select
End With
Next Cell
End Sub

Sub CheckColorIndex()
'by Wilson -- creates colour chart on worksheet
Dim CurrVal As Integer
Dim ColorChart As Range
Dim Cell As Range
Set ColorChart = Range("A1:G8")
CurrVal = 1
For Each Cell In ColorChart
Cell.Value = CurrVal
Cell.Select
Selection.Font.Size = 14
Selection.Font.Bold = True
Selection.Font.ColorIndex = 2
Selection.Interior.ColorIndex = Cell.Value
Selection.Interior.Pattern = xlSolid
CurrVal = CurrVal + 1
Next Cell
End Sub

 

[Jon Peltier]

I use a modified approach. I establish the named range "Formats" in a
worksheet, usually a dynamic range, just a column of cells with the
codes I'm looking up, and each cell is colored the way I want cells in
the working range to be colored. In this way, I can easily change the
colors and labels, without mucking around in the VBA (what color is 18,
anyway??). First I put the codes and colors into an array variable in
VBA (so I don't have to keep checking the range), then I loop through
the working range, and apply colors as required.

'' GET COLOR CODES FROM FORMAT RANGE
Set rFormats = Worksheets("Data").Range("Formats")
Imax = rFormats.rows.count
Redim lFormats(1 to Imax,3)
For I = 1 To Imax
lFormats(I, 1) = rFormats.Cells(I, 1).Interior.ColorIndex
lFormats(I, 2) = rFormats.Cells(I, 1).Font.ColorIndex
lFormats(I, 3) = rFormats.Cells(I, 1).Value
Next

'' APPLY COLOR FORMATS TO WORKING RANGE
Set rWorking = Worksheets("Output").Range("Working")
For Each cell In rWorking
For I = 1 to Imax
If cell.value = lFormats(I, 3) Then
cell.Interior.ColorIndex = lFormats(I, 1)
cell.Font.ColorIndex = lFormats(I, 2)
End If
Next
Next

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______