Case Select

J

Jimbola

Hello,

I've written this code to get round the conditional format limit.
The first case tests if the cell >50, but instead of changing the code
i want the cell A30 to hold the criteria as it can change. But using Case
range("A30") doesn't work. Can someone please point me in the write
direction


Private Sub Worksheet_Change(ByVal Target As Range)
' This macro is activated everytime a change is made to
' this worksheet (TestArea)
Dim r As Range
Dim cell As Range

'Set the range for the formatting
Set r = Intersect(Range("shtRange"), Target)

' If the change in the worksheet is not in the
' tested range, exit the macro.
If r Is Nothing Then Exit Sub

'Change to formatting of the cell that changed.
For Each cell In Range("BoxRange")
With cell
Select Case cell
Case Is > 50 <<<<<<<<<<<<<<<<<
.Interior.ColorIndex = Range("Condition").Offset(1, 2)
Case 2
.Interior.ColorIndex = 2
Case 3
.Interior.ColorIndex = 3
Case 4
.Interior.ColorIndex = 4
Case 5
.Interior.ColorIndex = 5
Case 6
.Interior.ColorIndex = 6
Case 7
.Interior.ColorIndex = 7
Case 8
.Interior.ColorIndex = 8
Case 9
.Interior.ColorIndex = 9
Case 10
.Interior.ColorIndex = 10
Case Else
.Interior.ColorIndex = 0

End Select

End With
Next

End Sub


Many thanks
J
 
B

Bob Phillips

Private Sub Worksheet_Change(ByVal Target As Range)
' This macro is activated everytime a change is made to
' this worksheet (TestArea)
Dim r As Range
Dim cell As Range

'Set the range for the formatting
Set r = Intersect(Range("shtRange"), Target)

' If the change in the worksheet is not in the
' tested range, exit the macro.
If r Is Nothing Then Exit Sub

'Change to formatting of the cell that changed.
Select Case Target.Value
Case Is > 50
.Interior.ColorIndex = Range("Condition").Offset(1, 2)
Case 2
.Interior.ColorIndex = 2
Case 3
.Interior.ColorIndex = 3
Case 4
.Interior.ColorIndex = 4
Case 5
.Interior.ColorIndex = 5
Case 6
.Interior.ColorIndex = 6
Case 7
.Interior.ColorIndex = 7
Case 8
.Interior.ColorIndex = 8
Case 9
.Interior.ColorIndex = 9
Case 10
.Interior.ColorIndex = 10
Case Else
.Interior.ColorIndex = 0
End Select

End Sub



--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
R

Ron Rosenfeld

Hello,

I've written this code to get round the conditional format limit.
The first case tests if the cell >50, but instead of changing the code
i want the cell A30 to hold the criteria as it can change. But using Case
range("A30") doesn't work. Can someone please point me in the write
direction
Click to expand...

Not sure what you mean by "doesn't work". But the following code work fine
using similar logic. If you could define, more clearly, what "doesn't work"
means ...

=====================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Range("F1")
Case Is < 20
Range("A1").Interior.Color = vbRed
Case Is < 50
Range("A1").Interior.Color = vbGreen
Case Else
Range("A1").Interior.Color = vbBlue
End Select
End Sub
======================



Private Sub Worksheet_Change(ByVal Target As Range)
' This macro is activated everytime a change is made to
' this worksheet (TestArea)
Dim r As Range
Dim cell As Range

'Set the range for the formatting
Set r = Intersect(Range("shtRange"), Target)

' If the change in the worksheet is not in the
' tested range, exit the macro.
If r Is Nothing Then Exit Sub

'Change to formatting of the cell that changed.
For Each cell In Range("BoxRange")
With cell
Select Case cell
Case Is > 50 <<<<<<<<<<<<<<<<<
.Interior.ColorIndex = Range("Condition").Offset(1, 2)
Case 2
.Interior.ColorIndex = 2
Case 3
.Interior.ColorIndex = 3
Case 4
.Interior.ColorIndex = 4
Case 5
.Interior.ColorIndex = 5
Case 6
.Interior.ColorIndex = 6
Case 7
.Interior.ColorIndex = 7
Case 8
.Interior.ColorIndex = 8
Case 9
.Interior.ColorIndex = 9
Case 10
.Interior.ColorIndex = 10
Case Else
.Interior.ColorIndex = 0

End Select

End With
Next

End Sub


Many thanks
J
Click to expand...

--ron
 
J

Jimbola

Sorry Bob I don't get this, it doesn't work. Thanks anyway
Let me re-explain the problem i am having, my original code works fine, but
for the first test rather than put the criteria in the code i would like it
in A30 as it can change.
 
J

Jimbola

Sorry i'm not being clear. What i want if for the criteria for select case to
reside in a cell. So for example in the code you gave instead of habing

Case is <20

i want something like

case range("A30")

and for the criteria e.g. <20 to reisde in A30 so it can be changed on the
sheet rather the code. In a similar way that i have the colour picked up from
the work sheet in my original code by using offset.
 
G

Gary Keramidas

not sure if this is what you want, and i don't have your range, but it will
set cell A3 to the color depending on the value in A30

Option Explicit
Dim cell As Range

Sub test()
Set cell = Range("A3")
With cell
Select Case Range("a30").Value

Case Is > 50
.Interior.ColorIndex = Range("Condition").Offset(1, 2)
Case 2
.Interior.ColorIndex = 2
Case 3
.Interior.ColorIndex = 3
Case 4
.Interior.ColorIndex = 4
Case 5
.Interior.ColorIndex = 5
Case 6
.Interior.ColorIndex = 6
Case 7
.Interior.ColorIndex = 7
Case 8
.Interior.ColorIndex = 8
Case 9
.Interior.ColorIndex = 9
Case 10
.Interior.ColorIndex = 10
Case Else
.Interior.ColorIndex = 0
End Select
End With
End Sub
 
J

Jimbola

sorry nope, its the actual criteria >50 that i want in cell A30, so it can be
changed on the sheet rather than the code.

thanks
 
G

Gary Keramidas

something like this?

Case Is > 50
.Interior.ColorIndex = Range("A30").Value

then when a30 is change the colorindex changes
 
J

Jimbola

sorry no, more like

case range("A30") where A30 can contain the criteria
(i.e >50)
..Interior.ColorIndex = Range("Condition").Offset(1, 2) < this works OK
not the problem

have just a number in A30 is can deal with but have the operand > => <>
and so on i can't figure
 
R

Ron Rosenfeld

Sorry i'm not being clear. What i want if for the criteria for select case to
reside in a cell. So for example in the code you gave instead of habing

Case is <20

i want something like

case range("A30")

and for the criteria e.g. <20 to reisde in A30 so it can be changed on the
sheet rather the code. In a similar way that i have the colour picked up from
the work sheet in my original code by using offset.
Click to expand...

OK, then something like this:

=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim expressionlist() As Long
Dim c As Range
Dim i As Long
Dim ExpressionListRange As Range

Set ExpressionListRange = [g1:g3]
ReDim expressionlist(ExpressionListRange.Count)

For Each c In ExpressionListRange
expressionlist(i) = c.Value
i = i + 1
Next c

Select Case Range("F1")
Case Is < expressionlist(0)
Range("A1").Interior.Color = vbRed
Case Is < expressionlist(1)
Range("A1").Interior.Color = vbGreen
Case Is < expressionlist(2)
Range("A1").Interior.Color = vbYellow
Case Else
Range("A1").Interior.Color = vbBlue
End Select
End Sub
==========================

or

==================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range

Select Case Range("F1")
Case Is < Range("g1").Value
Range("A1").Interior.Color = vbRed
Case Is < Range("g2").Value
Range("A1").Interior.Color = vbGreen
Case Is < Range("g3").Value
Range("A1").Interior.Color = vbYellow
Case Else
Range("A1").Interior.Color = vbBlue
End Select
End Sub
===================================


--ron
 
M

mailto.jos

I couldn't obtain the right results with a case select, so i did it
with a For ... Next loop:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Range

If Not IsEmpty(Target) Then
With Target
For Each cell In [Formats]
If Evaluate(.Value & cell) = True Then
cell.Offset(0, 1).Copy
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End If
Next cell
End With
End If
End Sub

I have a named range, "Formats", which is A1:A3, holding the text
"<50","=50",">50".
Using the Evaluate function, I effectively test
If ("49<50"=TRUE) Then ...

The loop checks all the criteria in A1:A3, and if it finds a match, it
copies the format from the cell next to the criterium to the target
cell. In the example of the target cell holding '53', it would copy
the format of cell B3 (since the text ">50" is in A3) to the active
cell.

Let me know if you get this to work/if it helped.
 
G

Gary Keramidas

another guess

c = Range("a30").Value

Case Is > c
.Interior.ColorIndex = Range("Condition").Offset(1, 2)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Pass condition formatting across worksheets via vba. 0
"ElseIf c.Value = "X_Clear" Then" and "...Target.Cells.Count > 1"don't work 4
Worksheet_Change Woes 6
Fill Color Macro 5
Runtime error 13 : type mismatch 2
Hi all, 4
Conditional Formatting through VBA ODBC 2
Highlight a cell after update in a specific range 2

Top