Conditional formating >3

[pl.carry]

I wonder if this is possible: I have an array of data of
Latitudes/Longitudes with the cell value being Altitude (DEM). With
condformat I have painted the cells in different colors for three different
altitude range. This looks like a nice topo map, but there are only three
colors due to conformat limitation. If I could have as many colors as a
standard topo map (why not 10) the display would look like a bona fide
topomap, especially if the value of the cells is made invisible and the
window is shrunk to "selection"=array.
SO
If I define the data array as in Sheet1, and if I define anywhere a LookUp
array with a vertical vector of altitudes, say, 1000, 1500, 2000, 2500, etc.
and next vector on right is a corresponding series of codes. Assume these
codes are windows color codes.
If in Sheet 2 for each corresponding cell in Sheet1 I write something like
"For ActiveCell Fill with colorcode found in lookup table in using Value
found in corresponding Cell in sheet1 as an input"
Would I get it? I have seen some VBA programming I believe that use
colorcodes.
Thanks,
Pierre

 

[J.E. McGimpsey]

Here's one way to do it:

Say your data in sheet1 extends from B2:Z26. Name the corresponding
range on sheet2 "topo"

Somewhere convenient, say in Sheet2, AB1:AC11, put the color codes:

AB AC
1 Altitude ColorIndex
2 0 5
3 1000 10
...
11 5000 50

and name AB2:AC11 "colors". XL can display up to 56 colors at a
time, so the values under ColorIndex will be 0 to 56 (you can add
validation to that column to keep users from entering invalid
colors).

In sheet2,B2, put

=VLOOKUP(Sheet1!B2,colors,2,TRUE)

Format "topo" with

Format/Cells/Number/Custom ;;;

which will hide all the values.

Finally right click on the Sheet2 worksheet tab, choose View code
and enter this in the module window that opens:

Private Sub Worksheet_Calculate()
Dim cell
For Each cell In Union(Range("topo"), _
Range("colors").Columns(2))
cell.Interior.ColorIndex = cell.Value
Next cell
End Sub

Now, any time a value is changed in Sheet1 or the color is changed
in the "color" table, the colors will be recalculated. You can
modify the colors that a colorindex corresponds to in
Tools/Options/Colors

 

[Jon Peltier]

Pierre -

Select your range and run this macro. You'll want to experiment with
your various altitude cutoffs and color indexes first.

Sub ContourMap()
Dim cel As Range
For Each cel In Selection.Cells
Select Case cel.Value
Case Is < 100
cel.Interior.ColorIndex = 5
Case Is < 200
cel.Interior.ColorIndex = 33
Case Is < 300
cel.Interior.ColorIndex = 8
Case Is < 400
cel.Interior.ColorIndex = 4
Case Is < 500
cel.Interior.ColorIndex = 43
Case Is < 600
cel.Interior.ColorIndex = 6
Case Is < 700
cel.Interior.ColorIndex = 44
Case Is < 800
cel.Interior.ColorIndex = 46
Case Else
cel.Interior.ColorIndex = 3
End Select
Next
End Sub

- Jon

 

[Jon Peltier]

Ooh, that's slicker than my proposal.

- Jon

Here's one way to do it:

Say your data in sheet1 extends from B2:Z26. Name the corresponding
range on sheet2 "topo"

Somewhere convenient, say in Sheet2, AB1:AC11, put the color codes:

AB AC
1 Altitude ColorIndex
2 0 5
3 1000 10
...
11 5000 50

and name AB2:AC11 "colors". XL can display up to 56 colors at a
time, so the values under ColorIndex will be 0 to 56 (you can add
validation to that column to keep users from entering invalid
colors).

In sheet2,B2, put

=VLOOKUP(Sheet1!B2,colors,2,TRUE)

Format "topo" with

Format/Cells/Number/Custom ;;;

which will hide all the values.

Finally right click on the Sheet2 worksheet tab, choose View code
and enter this in the module window that opens:

Private Sub Worksheet_Calculate()
Dim cell
For Each cell In Union(Range("topo"), _
Range("colors").Columns(2))
cell.Interior.ColorIndex = cell.Value
Next cell
End Sub

Now, any time a value is changed in Sheet1 or the color is changed
in the "color" table, the colors will be recalculated. You can
modify the colors that a colorindex corresponds to in
Tools/Options/Colors

 

[J.E. McGimpsey]

Forgot one step:

After:

In sheet2,B2, put

=VLOOKUP(Sheet1!B2,colors,2,TRUE)


Copy that formula to the rest of "topo"

 

[Pierre]

Jon, thank you, I got to run this alright.
I can't get Gimpsey's to work however, I get everything a nice blue.
Will continue to try.
Pierre

 

[Pierre]

Thank you, I got to run Jon's alright with my data.
But I can't get yours to work, I get everything a nice blue. I checked the
indexes, everything, the data set is the same than for Jon, there is no
syntax error apparently.
Will continue to try.
Pierre

 

[J.E. McGimpsey]

Thank you, I got to run Jon's alright with my data.
But I can't get yours to work, I get everything a nice blue. I checked the
indexes, everything, the data set is the same than for Jon, there is no
syntax error apparently.
Will continue to try.

I posted a demo worksheet to my ftp site:

ftp://ftp.mcgimpsey.com/excel/pierre_demo.xls

 

[Pierre]

Looks like I am not getting quickly to success here: hard as I tried the
link did not succeed. I asked a friend and the ISP assistance to try; they
also did not get any result. is there some glaring thing I leave out? Can
you email the attachment?
Tx,
Pierre

 

[Pierre]

Thank you works now. There was a problem getting to the ftp due to double
Firewall play (XP, McAfee)
Pierre

 

[J.E. McGimpsey]

Done.