VBA ColorIndexofCF autocalc help - autocalc data in one worksheet is remove when same function calcs in another worksheet

[svanhoose]

First, I am a novice to VBA, and I have scoured forums, websites, etc. trying to find the tweak(s) needed for my code to get it to work the way I want. I have been working on a spreadsheet that pulls data into specific cells based on conditional formatting of selections in other cells. I have used IF formulas that include a ColorIndexofCF module to return values from the analyzed, conditional formatted data to a set of specific cells. I wanted those specific cells to autocalculate after pulling the TRUE value from the cell that met my conditional formatting. In order to do that, the only solution I could find is by incorporating an Application.Volatile True statement into the module so the cells would autoupdate.

My workbook has four worksheets and the autoupdate works when the IF formulas are executed. My dilemma is that I am struggling to understand why, when the cells that use the IF ColorIndexofCF formulas are recalculated in one worksheet, they reset or empty the IF ColorIndexofCF formulas in the other worksheets. If I try to recalc the formlas in the other worksheets, it resets the data from the first worksheet. I think their is a Loop that causes the reset, and I don't know the VBA coding that would fix it.

I can send you my spreadsheet if it will help you to help me figure it out. Thank you in advance for any help you can offer.

The module code I used is as follows:

---

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 ColorIndexOfCF(Rng As Range, _
Optional OfText As Boolean = False) As Integer
Application.Volatile
Dim AC As Integer
AC = ActiveCondition(Rng)
If AC = 0 Then
If OfText = True Then
ColorIndexOfCF = Rng.Font.ColorIndex
Else
ColorIndexOfCF = Rng.Interior.ColorIndex
End If
Else
If OfText = True Then
ColorIndexOfCF = Rng.FormatConditions(AC).Font.ColorIndex
Else
ColorIndexOfCF = Rng.FormatConditions(AC).Interior.ColorIndex
End If
End If


End Function



'''''''''''''''''''''''''''''''''''''''




Function ColorOfCF(Rng As Range, Optional OfText As Boolean = False) As Long
Dim AC As Integer
AC = ActiveCondition(Rng)
If AC = 0 Then
If OfText = True Then
ColorOfCF = Rng.Font.Color
Else
ColorOfCF = Rng.Interior.Color
End If
Else
If OfText = True Then
ColorOfCF = Rng.FormatConditions(AC).Font.Color
Else
ColorOfCF = Rng.FormatConditions(AC).Interior.Color
End If
End If


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



'''''''''''''''''''''''''''''''''''''''


Function CountOfCF(InRange As Range, _
Optional Condition As Integer = -1) As Long
Dim Count As Long
Dim Rng As Range
Dim FCNum As Integer


For Each Rng In InRange.Cells
FCNum = ActiveCondition(Rng)
If FCNum > 0 Then
If Condition = -1 Or Condition = FCNum Then
Count = Count + 1
End If
End If
Next Rng
CountOfCF = Count
End Function


'''''''''''''''''''''''''''''''''''''''


Function SumByCFColorIndex(Rng As Range, CI As Integer) As Double
Dim R As Range
Dim Total As Double
For Each R In Rng.Cells
If ColorIndexOfCF(R, False) = CI Then
Total = Total + R.Value
End If
Next R
SumByCFColorIndex = Total
End Function