Hi all

I want to improve my VB colorbar sub programing to color bar chart below.
This sub has the problem of range pre-defined at A2:A9.
For Each Rng In Range("A2:A9") !!
How can I modify it so it can scan any range? Because my workbook change
often but the column name not change.
Thanks
Daniel


-------------------------------------------------------

Sub colorbarr()



Application.ScreenUpdating = False

Dim Rng As Range
Dim Cnt As Integer

Cnt = 1

For Each Rng In Range("A2:A9")
Set Pts = ActiveChart.SeriesCollection(1).Points(Cnt)
If Rng.Value = "im" Then
Pts.Interior.ColorIndex = 24
ElseIf Rng.Value = "surg" Then
Pts.Interior.ColorIndex = 45
ElseIf Rng.Value = "ms" Then
Pts.Interior.ColorIndex = 19
ElseIf Rng.Value = "other" Then
Pts.Interior.ColorIndex = 35
End If
Cnt = Cnt + 1
Next Rng
End Sub

Something like this:

Sub ColorBarr()

Dim rCell As Range
Dim rTotal As Range
Dim Cnt As Integer

If TypeName(Selection) < "Range" Then Exit Sub

Set rTotal = Selection

Cnt = 1

For Each rCell In rTotal.Cells
' etc.

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


"Daniel" wrote in message
...

Hi all

I want to improve my VB colorbar sub programing to color bar chart below.
This sub has the problem of range pre-defined at A2:A9.
For Each Rng In Range("A2:A9") !!
How can I modify it so it can scan any range? Because my workbook change
often but the column name not change.
Thanks
Daniel


-------------------------------------------------------

Sub colorbarr()



Application.ScreenUpdating = False

Dim Rng As Range
Dim Cnt As Integer

Cnt = 1

For Each Rng In Range("A2:A9")
Set Pts = ActiveChart.SeriesCollection(1).Points(Cnt)
If Rng.Value = "im" Then
Pts.Interior.ColorIndex = 24
ElseIf Rng.Value = "surg" Then
Pts.Interior.ColorIndex = 45
ElseIf Rng.Value = "ms" Then
Pts.Interior.ColorIndex = 19
ElseIf Rng.Value = "other" Then
Pts.Interior.ColorIndex = 35
End If
Cnt = Cnt + 1
Next Rng
End Sub

Thanks Jon for respond my question
I modified my sub colorbar to scan all cells in column A and F. I tried
this as below to read the range in column A and F but it show error after
execute this macro ?

For Each Rng In Range ("A:A, F:F")

DO not know why and how should I change?
Daniel



"Jon Peltier" wrote:

Something like this:

Sub ColorBarr()

Dim rCell As Range
Dim rTotal As Range
Dim Cnt As Integer

If TypeName(Selection) < "Range" Then Exit Sub

Set rTotal = Selection

Cnt = 1

For Each rCell In rTotal.Cells
' etc.

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


"Daniel" wrote in message
...

Hi all

I want to improve my VB colorbar sub programing to color bar chart below.
This sub has the problem of range pre-defined at A2:A9.
For Each Rng In Range("A2:A9") !!
How can I modify it so it can scan any range? Because my workbook change
often but the column name not change.
Thanks
Daniel


-------------------------------------------------------

Sub colorbarr()



Application.ScreenUpdating = False

Dim Rng As Range
Dim Cnt As Integer

Cnt = 1

For Each Rng In Range("A2:A9")
Set Pts = ActiveChart.SeriesCollection(1).Points(Cnt)
If Rng.Value = "im" Then
Pts.Interior.ColorIndex = 24
ElseIf Rng.Value = "surg" Then
Pts.Interior.ColorIndex = 45
ElseIf Rng.Value = "ms" Then
Pts.Interior.ColorIndex = 19
ElseIf Rng.Value = "other" Then
Pts.Interior.ColorIndex = 35
End If
Cnt = Cnt + 1
Next Rng
End Sub

Try

For Each Rng In Range("A:A, F:F").Cells

Then if you are doing the cells in each row of the two columns in
conjunction:

Dim Rng2 As Range
For Each Rng In Range("A:A").Cells
Set Rng2 = Rng.Offset(0, 5)

This way you can get both values and process them in the same algorithm.

Now, Range("A:A") has a lot of cells, so you could also try this:

Dim BigRange As Range
Dim Rng1 As Range
Dim Rng2 As Range

Set BigRange = Intersect(ActiveSheet.UsedRange,
ActiveSheet.Range("A:A"))

For Each Rng1 In BigRange.Cells
Set Rng2 = Rng1.Offset(0, 5)

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


"Daniel" wrote in message
...
Thanks Jon for respond my question
I modified my sub colorbar to scan all cells in column A and F. I tried
this as below to read the range in column A and F but it show error after
execute this macro ?

For Each Rng In Range ("A:A, F:F")

DO not know why and how should I change?
Daniel



"Jon Peltier" wrote:

Something like this:

Sub ColorBarr()

Dim rCell As Range
Dim rTotal As Range
Dim Cnt As Integer

If TypeName(Selection) < "Range" Then Exit Sub

Set rTotal = Selection

Cnt = 1

For Each rCell In rTotal.Cells
' etc.

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


"Daniel" wrote in message
...

Hi all

I want to improve my VB colorbar sub programing to color bar chart
below.
This sub has the problem of range pre-defined at A2:A9.
For Each Rng In Range("A2:A9") !!
How can I modify it so it can scan any range? Because my workbook
change
often but the column name not change.
Thanks
Daniel


-------------------------------------------------------

Sub colorbarr()



Application.ScreenUpdating = False

Dim Rng As Range
Dim Cnt As Integer

Cnt = 1

For Each Rng In Range("A2:A9")
Set Pts = ActiveChart.SeriesCollection(1).Points(Cnt)
If Rng.Value = "im" Then
Pts.Interior.ColorIndex = 24
ElseIf Rng.Value = "surg" Then
Pts.Interior.ColorIndex = 45
ElseIf Rng.Value = "ms" Then
Pts.Interior.ColorIndex = 19
ElseIf Rng.Value = "other" Then
Pts.Interior.ColorIndex = 35
End If
Cnt = Cnt + 1
Next Rng
End Sub