Code worked in 2003 version but not in 2007

[springbrook]

I need urgent help please.
Kindley thanking you in advance.

Hi below is the code that I was given by some years ago. It works perfectly in 2003 version of Excel but not in 2007.

As I am not too familiar with this code I need urgent help.
The end goal of the code (which is attached to a command button) is to check the current sheet for any cells that have green or red cell as a result of conditional formatting which is caused by an incorrect answer in the cell.

Ie: If any cells display red or green, the the cell eaither contain incorect data or no dat has been input into the cell.
When clicking the command button, the code is to check the sheet and if there are no red or green cells then open the next sheet for access.

Below is the code wich sits in a module.
The "FunctionGetStrippedValue" right down the bottom of the code seems to be the area where the debugging takes me to.



Function ActiveCondition(Rng As Range) As Integer
Dim Ndx As Long
Dim FC As FormatCondition
Dim Temp As Variant
Dim Temp2 As Variant

If Rng.FormatConditions.Count = 0 Then
ActiveCondition = 0
Else
For Ndx = 1 To Rng.FormatConditions.Count
Set FC = Rng.FormatConditions(Ndx)
Select Case FC.Type
Case xlCellValue
Select Case FC.Operator
Case xlBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
CDbl(Rng.Value) <= CDbl(FC.Formula2) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Temp And _
Rng.Value <= Temp2 Then
ActiveCondition = Ndx
Exit Function
End If
End If

Case xlGreater
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value > Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If

Case xlEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Temp = Rng.Value Then
ActiveCondition = Ndx
Exit Function
End If
End If


Case xlGreaterEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If


Case xlLess
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value < Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If

Case xlLessEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value <= Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If


Case xlNotEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Temp <> Rng.Value Then
ActiveCondition = Ndx
Exit Function
End If
End If

Case xlNotBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If Not CDbl(Rng.Value) <= CDbl(FC.Formula1) And _
CDbl(Rng.Value) >= CDbl(FC.Formula2) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Not Rng.Value <= Temp And _
Rng.Value >= Temp2 Then
ActiveCondition = Ndx
Exit Function
End If
End If

Case Else
Debug.Print "UNKNOWN OPERATOR"
End Select


Case xlExpression
If Application.Evaluate(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If

Case Else
Debug.Print "UNKNOWN TYPE"
End Select

Next Ndx

End If

ActiveCondition = 0

End Function




Function GetStrippedValue(CF As String) As String
Dim Temp As String
If InStr(1, CF, "=", vbTextCompare) Then
Temp = Mid(CF, 3, Len(CF) - 3)
If Left(Temp, 1) = "=" Then
Temp = Mid(Temp, 2)
End If
Else
Temp = CF
End If
GetStrippedValue = Temp
End Function

 

[springbrook]

Please help me

Can anyone please help me with the above problem

 

[Norie]

How is the code not working?

I'm afraid I don't have 2007 so I can't test it there.

And I don't see anything in the code that is version specific but I've only had a glance at it.

I also don't see anything in the code that's opening/activating another sheet.

 

[springbrook]

How is the code not working?

I'm afraid I don't have 2007 so I can't test it there.

And I don't see anything in the code that is version specific but I've only had a glance at it.

I also don't see anything in the code that's opening/activating another sheet.

Below is the seperate code to activate it, it is assigned to a command button.

I have just done some pain stakingly search for the fault.
It is seem that the 2007 version does not work with this code if one of the cells that is to be checked has more than one conditional formatting rule appplied to it.

Once I removed the second rule the code worked fine agian.



My code to the command button which activates it.

Private Sub CommandButton1_Click()
'Private Sub Checkcondition()
Application.ScreenUpdating = False
For Each cell In Range("A3:L120").Cells
cell.Activate
If ActiveCondition(ActiveCell) <> 0 Then
e = e + 1
End If
Next cell
Application.ScreenUpdating = True
If e = 0 Then
'ThisWorkbook.Unprotect Password:="yourpasswordhere"
Sheets("LOADING LIST").Visible = xlSheetVisible
'ThisWorkbook.Protect Password:="yourpasswordhere"
Sheets("LOADING LIST").Select
Else: MsgBox "Data Conflict! Please resolve GREEN and RED cells!"
End If
End Sub