PDA

View Full Version : vba to check conditional color and move right



CCkfm2000
12-01-2006, 10:34 AM
hi all..

i've this code below that works if the cell color is set to black, but what i need to do is change it check the conditional color not the cell color.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Interior.ColorIndex = 1 Then
Target.Offset(0, 1).Select
End If
End Sub


thanks

Cyberdude
12-01-2006, 02:34 PM
I occurred to me that the big problem is knowing what if the format conditions are true or not is what you need to look at, not the color.

I'm assumming that you know how the conditional formatting has been written for the cell, so perhaps you can determine if the the conditions for setting it red (for example) are true. It they are, then the cell must be red.

That's an over simplification because there's a possibility for 3 different sets of conditions, and they have a hierarchical preference for being used. For example, the conditons for set 2 may be true, but the conditions in set 1 are also true and therefore will dominate.

Sorry I don't have the time now to work out an example, but I thought maybe testing the conditions for true and false might be easier than trying to test for the color directly.


HTO. Sid

malik641
12-01-2006, 03:37 PM
If you know which condition you want to look at (1, 2, 3), then you could do something like:

From the Immediate Window:
?Range("B2").FormatConditions(1).Interior.ColorIndex
36

And you should check if there is any conditions set to begin with using the FormatConditions.Count property.

HTH also

mdmackillop
12-01-2006, 04:10 PM
Here's some code by Byundt http://vbaexpress.com/kb/getarticle.php?kb_id=190
Regards
MD



Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ConditionalColor(Target, "Interior") = 1 Then
Target.Offset(0, 1).Select
End If
End Sub

Function ConditionalColor(rg As Range, FormatType As String) As Long
'Returns the color index (either font or interior) of the first cell in range rg. If no _
conditional format conditions apply, then returns the regular color of the cell. _
FormatType is either "Font" or "Interior"
Dim cel As Range
Dim tmp As Variant
Dim boo As Boolean
Dim frmla As String, frmlaR1C1 As String, frmlaA1 As String
Dim i As Long
'Application.Volatile 'This statement required if Conditional Formatting for rg is determined by the _
value of other cells
Set cel = rg.Cells(1, 1)
Select Case Left(LCase(FormatType), 1)
Case "f" 'Font color
ConditionalColor = cel.Font.ColorIndex
Case Else 'Interior or highlight color
ConditionalColor = cel.Interior.ColorIndex
End Select
If cel.FormatConditions.Count > 0 Then
'On Error Resume Next
With cel.FormatConditions
For i = 1 To .Count 'Loop through the three possible format conditions for each cell
frmla = .Item(i).Formula1
If Left(frmla, 1) = "=" Then 'If "Formula Is", then evaluate if it is True
'Conditional Formatting is interpreted relative to the active cell. _
This cause the wrong results if the formula isn't restated relative to the cell containing the _
Conditional Formatting--hence the workaround using ConvertFormula twice in a row. _
If the function were not called using a worksheet formula, you could just activate the cell instead.
frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)
boo = Application.Evaluate(frmlaA1)
Else 'If "Value Is", then identify the type of comparison operator and build comparison formula
Select Case .Item(i).Operator
Case xlEqual ' = x
frmla = cel & "=" & .Item(i).Formula1
Case xlNotEqual ' <> x
frmla = cel & "<>" & .Item(i).Formula1
Case xlBetween 'x <= cel <= y
frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
Case xlNotBetween 'x > cel or cel > y
frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
Case xlLess ' < x
frmla = cel & "<" & .Item(i).Formula1
Case xlLessEqual ' <= x
frmla = cel & "<=" & .Item(i).Formula1
Case xlGreater ' > x
frmla = cel & ">" & .Item(i).Formula1
Case xlGreaterEqual ' >= x
frmla = cel & ">=" & .Item(i).Formula1
End Select
boo = Application.Evaluate(frmla) 'Evaluate the "Value Is" comparison formula
End If

If boo Then 'If this Format Condition is satisfied
On Error Resume Next
Select Case Left(LCase(FormatType), 1)
Case "f" 'Font color
tmp = .Item(i).Font.ColorIndex
Case Else 'Interior or highlight color
tmp = .Item(i).Interior.ColorIndex
End Select
If Err = 0 Then ConditionalColor = tmp
Err.Clear
On Error GoTo 0
Exit For 'Since Format Condition is satisfied, exit the inner loop
End If
Next i
End With
End If
End Function

Bob Phillips
12-02-2006, 08:51 AM
If you know which condition you want to look at (1, 2, 3), then you could do something like:

From the Immediate Window:
?Range("B2").FormatConditions(1).Interior.ColorIndex
36
And you should check if there is any conditions set to begin with using the FormatConditions.Count property.

HTH also

That tells him what the colour is IF the condition is satisfied, not which colour has been set.

Bob Phillips
12-02-2006, 08:54 AM
This function returns False if the conditions is not met, else the colorinfex



'---------------------------------------------------------------------
Public Function CFColorindex(rng As Range)
'---------------------------------------------------------------------
Dim oFC As FormatCondition
Dim sF1 As String
Dim iRow As Long
Dim iColumn As Long

Set rng = rng(1, 1)
If rng.FormatConditions.Count > 0 Then
For Each oFC In rng.FormatConditions
If oFC.Type = xlCellValue Then
Select Case oFC.Operator
Case xlEqual
CFColorindex = rng.Value = oFC.Formula1
Case xlNotEqual
CFColorindex = rng.Value <> oFC.Formula1
Case xlGreater
CFColorindex = rng.Value > oFC.Formula1
Case xlGreaterEqual
CFColorindex = rng.Value >= oFC.Formula1
Case xlLess
CFColorindex = rng.Value < oFC.Formula1
Case xlLessEqual
CFColorindex = rng.Value <= oFC.Formula1
Case xlBetween
CFColorindex = (rng.Value >= oFC.Formula1 And _
rng.Value <= oFC.Formula2)
Case xlNotBetween
CFColorindex = (rng.Value < oFC.Formula1 Or _
rng.Value > oFC.Formula2)
End Select
Else
're-adjust the formula back to the formula that applies
'to the cell as relative formulae adjust to the activecell
With Application
iRow = rng.Row
iColumn = rng.Column
sF1 = .Substitute(oFC.Formula1, "ROW()", iRow)
sF1 = .Substitute(sF1, "COLUMN()", iColumn)
sF1 = .ConvertFormula(sF1, xlA1, xlR1C1)
sF1 = .ConvertFormula(sF1, xlR1C1, xlA1, , rng)
End With
CFColorindex = rng.Parent.Evaluate(sF1)
End If

If CFColorindex Then
If Not IsNull(oFC.Interior.ColorIndex) Then
CFColorindex = oFC.Interior.ColorIndex
Exit Function
End If
End If
Next oFC
End If 'rng.FormatConditions.Count > 0

End Function

malik641
12-02-2006, 09:33 AM
That tells him what the colour is IF the condition is satisfied, not which colour has been set.
It says the same color whether the condition is true or false. And CCkfm2000 didn't mention if they wanted to see if the condition was true. I was just showing how to get to the conditional formatting color whether true or not.

Unless I was confused about the post...

Nice funciton, btw :)

Bob Phillips
12-02-2006, 10:54 AM
It says the same color whether the condition is true or false. And CCkfm2000 didn't mention if they wanted to see if the condition was true.

That's true, but it is not the same cell colour regardless.

malik641
12-02-2006, 11:36 AM
That's true, but it is not the same cell colour regardless.
I see what you're saying. Yes, the conditional formatting color won't be the same as the cell color regardless if true or false....unless the cell just happened to be set manually that way.

CCkfm2000
12-04-2006, 04:48 AM
Thanks all for replying, the code below works well for what I need.

I?ve attached a copy of the spreadsheet I?m working on.

As you see the columns N, S and X are condition coded when the header = x.

By changing the shift in cell F2 the header is changed.

Would it be possible to change the code that


If I move right it jumps the cell and moves right. [ This part works ]
If I move left it jumps the cell and moves left.

Here's some code by Byundt http://vbaexpress.com/kb/getarticle.php?kb_id=190
Regards
MD



Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ConditionalColor(Target, "Interior") = 1 Then
Target.Offset(0, 1).Select
End If
End Sub

Function ConditionalColor(rg As Range, FormatType As String) As Long
'Returns the color index (either font or interior) of the first cell in range rg. If no _
conditional format conditions apply, then returns the regular color of the cell. _
FormatType is either "Font" or "Interior"
Dim cel As Range
Dim tmp As Variant
Dim boo As Boolean
Dim frmla As String, frmlaR1C1 As String, frmlaA1 As String
Dim i As Long
'Application.Volatile 'This statement required if Conditional Formatting for rg is determined by the _
value of other cells
Set cel = rg.Cells(1, 1)
Select Case Left(LCase(FormatType), 1)
Case "f" 'Font color
ConditionalColor = cel.Font.ColorIndex
Case Else 'Interior or highlight color
ConditionalColor = cel.Interior.ColorIndex
End Select
If cel.FormatConditions.Count > 0 Then
'On Error Resume Next
With cel.FormatConditions
For i = 1 To .Count 'Loop through the three possible format conditions for each cell
frmla = .Item(i).Formula1
If Left(frmla, 1) = "=" Then 'If "Formula Is", then evaluate if it is True
'Conditional Formatting is interpreted relative to the active cell. _
This cause the wrong results if the formula isn't restated relative to the cell containing the _
Conditional Formatting--hence the workaround using ConvertFormula twice in a row. _
If the function were not called using a worksheet formula, you could just activate the cell instead.
frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)
boo = Application.Evaluate(frmlaA1)
Else 'If "Value Is", then identify the type of comparison operator and build comparison formula
Select Case .Item(i).Operator
Case xlEqual ' = x
frmla = cel & "=" & .Item(i).Formula1
Case xlNotEqual ' <> x
frmla = cel & "<>" & .Item(i).Formula1
Case xlBetween 'x <= cel <= y
frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
Case xlNotBetween 'x > cel or cel > y
frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
Case xlLess ' < x
frmla = cel & "<" & .Item(i).Formula1
Case xlLessEqual ' <= x
frmla = cel & "<=" & .Item(i).Formula1
Case xlGreater ' > x
frmla = cel & ">" & .Item(i).Formula1
Case xlGreaterEqual ' >= x
frmla = cel & ">=" & .Item(i).Formula1
End Select
boo = Application.Evaluate(frmla) 'Evaluate the "Value Is" comparison formula
End If

If boo Then 'If this Format Condition is satisfied
On Error Resume Next
Select Case Left(LCase(FormatType), 1)
Case "f" 'Font color
tmp = .Item(i).Font.ColorIndex
Case Else 'Interior or highlight color
tmp = .Item(i).Interior.ColorIndex
End Select
If Err = 0 Then ConditionalColor = tmp
Err.Clear
On Error GoTo 0
Exit For 'Since Format Condition is satisfied, exit the inner loop
End If
Next i
End With
End If
End Function






thanks again..

CCkfm2000
12-04-2006, 04:49 AM
Thanks all for replying, the code below works well for what I need.

I?ve attached a copy of the spreadsheet I?m working on.

As you see the columns N, S and X are condition coded when the header = x.

By changing the shift in cell F2 the header is changed.

Would it be possible to change the code that

If I move right it jumps the cell and moves right. [ This part works ]
If I move left it jumps the cell and moves left.
Here's some code by Byundt http://vbaexpress.com/kb/getarticle.php?kb_id=190
Regards
MD



Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ConditionalColor(Target, "Interior") = 1 Then
Target.Offset(0, 1).Select
End If
End Sub

Function ConditionalColor(rg As Range, FormatType As String) As Long
'Returns the color index (either font or interior) of the first cell in range rg. If no _
conditional format conditions apply, then returns the regular color of the cell. _
FormatType is either "Font" or "Interior"
Dim cel As Range
Dim tmp As Variant
Dim boo As Boolean
Dim frmla As String, frmlaR1C1 As String, frmlaA1 As String
Dim i As Long
'Application.Volatile 'This statement required if Conditional Formatting for rg is determined by the _
value of other cells
Set cel = rg.Cells(1, 1)
Select Case Left(LCase(FormatType), 1)
Case "f" 'Font color
ConditionalColor = cel.Font.ColorIndex
Case Else 'Interior or highlight color
ConditionalColor = cel.Interior.ColorIndex
End Select
If cel.FormatConditions.Count > 0 Then
'On Error Resume Next
With cel.FormatConditions
For i = 1 To .Count 'Loop through the three possible format conditions for each cell
frmla = .Item(i).Formula1
If Left(frmla, 1) = "=" Then 'If "Formula Is", then evaluate if it is True
'Conditional Formatting is interpreted relative to the active cell. _
This cause the wrong results if the formula isn't restated relative to the cell containing the _
Conditional Formatting--hence the workaround using ConvertFormula twice in a row. _
If the function were not called using a worksheet formula, you could just activate the cell instead.
frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)
boo = Application.Evaluate(frmlaA1)
Else 'If "Value Is", then identify the type of comparison operator and build comparison formula
Select Case .Item(i).Operator
Case xlEqual ' = x
frmla = cel & "=" & .Item(i).Formula1
Case xlNotEqual ' <> x
frmla = cel & "<>" & .Item(i).Formula1
Case xlBetween 'x <= cel <= y
frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
Case xlNotBetween 'x > cel or cel > y
frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
Case xlLess ' < x
frmla = cel & "<" & .Item(i).Formula1
Case xlLessEqual ' <= x
frmla = cel & "<=" & .Item(i).Formula1
Case xlGreater ' > x
frmla = cel & ">" & .Item(i).Formula1
Case xlGreaterEqual ' >= x
frmla = cel & ">=" & .Item(i).Formula1
End Select
boo = Application.Evaluate(frmla) 'Evaluate the "Value Is" comparison formula
End If

If boo Then 'If this Format Condition is satisfied
On Error Resume Next
Select Case Left(LCase(FormatType), 1)
Case "f" 'Font color
tmp = .Item(i).Font.ColorIndex
Case Else 'Interior or highlight color
tmp = .Item(i).Interior.ColorIndex
End Select
If Err = 0 Then ConditionalColor = tmp
Err.Clear
On Error GoTo 0
Exit For 'Since Format Condition is satisfied, exit the inner loop
End If
Next i
End With
End If
End Function






thanks again..