IF and AND statements

[Sam Harman]

My original thred has gone cold so thought i would post an update..

thanks in advance

Sam

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



Yes sorry I appreciate that it is difficult

What I can tell you is this is an example from two lines of the table

R DP DQ DR = DP-DQ) DS DT = (DP-R)
0 79 80 -1 -1 79
3 74 76 -2 -2 71

Ideally I would like to conditionally format DT line two as the value
of this line (71) is less than DP (74). The first line would not be
formatted as the value of DTand DP is the same. Also if any cell in DP
has a value of 0 I want to ignore that completely regardless of what
value is in cell DT

Hope that helps


Regards

Sam

 

[Sam Harman]

Hi Ron, I hope you are well and thanks for such a swift resolution to
my query.

However, I have a problem on my hands which is disastrous and
hopefully you will be able to assist.

You may remember that you kindly provided me with code for CountYellow
and CountFmt (Format) which would allow me to count the number of
cells which were coloured yellow or had conditional formatting.

These have been working flawlessley for weeks. However, today when I
opened my spreadsheet and tried to calculate some cells I got an error
message as follows:

Conditional formatting cannot be processed.

When I broke the code and went into the debugger it had highlighted
the CountFmt module and in yellow the Exit Function was highlighted.

I really hope you can help identify the issue here as these modules
are a key part of my spreadsheet.

With kind regards

Sam

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

Below is the CountFmr module code you created for me.


Function CountFmt(rg As Range) As Long
Dim c As Range
Dim t As Long
Dim fc As FormatCondition
Dim c1 As Double, c2 As Double
For Each c In rg
If c.Interior.ColorIndex <> xlColorIndexNone Then
t = t + 1
ElseIf c.FormatConditions.Count > 0 Then
For Each fc In c.FormatConditions
Select Case fc.Type
Case Is = xlCellValue
If fc.Operator <> xlBetween Then
MsgBox ("Conditional Format cannot be processed")
Exit Function
End If
c1 = Evaluate(fc.Formula1)
c2 = Evaluate(fc.Formula2)
If c.Value >= c1 And c.Value <= c2 Then
t = t + 1
End If
Case Is = xlExpression
If Evaluate(fc.Formula1) = True Then t = t + 1
Case Else
MsgBox ("Conditional Format cannot be processed")
Exit Function
End Select
Next fc
End If
Next c
CountFmt = t
End Function

 

[Sam Harman]

Hi Ron, and as usual thank you so much for your reply.

You have no idea how worried I was that all my work (and all of your
formulae etc !) was going to be undone by this error which I could not
track down...your code helped me identify the problem which was to do
with the conditional formatting of cells which I hope I have managed
to rectify and so far so good.

I would just like to add Ron, that people on these forums and for me,
you in particular typify the benefits of the internet. Without your
help my spreadsheet would be nowhere near as polished as it is and you
have saved me so much time with your help, advice and in particular
the modules which have all worked brilliantly. I am quite astounded by
your knowledge of excel but more so in the time you have given me to
pass on the benefit of your expertise.

I wish you all the best for the holidays and I will be back soon to
test your patience again after xmas and into the new year

Hope you don't mind !

Kind regards

Sam

 

[Sam Harman]

Hi Ron, hope you had a good xmas.

I have encountered a problem since correcting the CF of the cells that
were causing an error in that the modules which you cretaed to colour
the cells based on their number are misbehaving !

For exmaple....the following macro which has flawlessly highlighted
the lowest number as yellow background / red font and the next three
loest numbers as green background / red font....is now not working
properly. No other data has been changed, no formats etc and the cells
which the macro looks in are all as they were before I had the problem
with the 'Cannot process CF cells error messge...

I know it must be difficult for you to work out what might have gone
wrong but I am guessing itmust be linked to the errors I was getting
previously.

The Color4New and other variances I have added to the spreadsheet
(Color3New etc) are all fundamental aspects of it operating properly
so I am at a loss to understand why this has happened.

Is there anything in the code below that might help point me in the
right direction?

Thanks in advance

Sam

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

Sub Color4New2011()
Dim rTimes As Range, rValues As Range, c As Range
Const NumToColor As Long = 4
Dim APOffset() As Long
Dim tTimes() As Variant, dPVals() As Double
Dim collTime As Collection, collColQ As Collection
Dim bLowest As Boolean
Dim i As Long, j As Long, k As Long

On Error Resume Next

Set rTimes = Application.InputBox(Prompt:="Select the Times", _
Default:=Selection.Address, Type:=8)
If rTimes Is Nothing Then Exit Sub

Set rValues = Application.InputBox("Select One (1) cell in each column
of Values ", Type:=8)
If rValues Is Nothing Then Exit Sub

On Error GoTo 0

bLowest = IIf(MsgBox("Lowest " & NumToColor & "?", vbYesNo) = vbYes,
True, False)

ReDim APOffset(0 To rValues.Count - 1)
i = 0
For Each c In rValues
APOffset(i) = c.Column - rTimes.Column
i = i + 1
Next c

'Unique list of times
Set collTime = New Collection
On Error Resume Next
For Each c In rTimes
collTime.Add Item:=c.Value, Key:=CStr(c.Value)
Next c
On Error GoTo 0

ReDim tTimes(0 To collTime.Count - 1, 0 To 2)
For i = 0 To collTime.Count - 1
tTimes(i, 0) = collTime(i + 1)
Next i

Application.ScreenUpdating = False
For k = 0 To UBound(APOffset)
'unique list of rValues values for each time
For i = 0 To UBound(tTimes, 1)
Set collColQ = New Collection
On Error Resume Next
For Each c In rTimes
If c.Value = tTimes(i, 0) Then
With c.Offset(columnoffset:=APOffset(k))
If bLowest = True Then collColQ.Add Item:=.Value,
Key:=CStr(.text)
If bLowest = False And .Value <> 0 Then
collColQ.Add Item:=.Value, Key:=CStr(.text)
End With
End If
Next c
On Error GoTo 0
If collColQ.Count > 0 Then
ReDim dPVals(0 To collColQ.Count - 1)
For j = 0 To UBound(dPVals)
dPVals(j) = collColQ(j + 1)
Next j
End If
With WorksheetFunction
If bLowest Then
tTimes(i, 1) = .Small(dPVals, .Min(UBound(dPVals) + 1,
NumToColor))
tTimes(i, 2) = .Min(dPVals)
Else
tTimes(i, 1) = .Large(dPVals, .Min(UBound(dPVals) + 1,
NumToColor))
tTimes(i, 2) = .Max(dPVals)
End If

End With
Next i

'color the cells
For i = 0 To UBound(tTimes, 1)
For Each c In rTimes
If c.Value = tTimes(i, 0) Then
With c.Offset(columnoffset:=APOffset(k))
If bLowest = False Then
'Select Case CDbl(.Text)
Select Case .Value
Case Is = tTimes(i, 2)
.Interior.Color = vbYellow
.Font.Color = vbRed
Case Is >= tTimes(i, 1)
.Interior.Color = vbGreen
.Font.Color = vbRed
Case Else
.Interior.Color = xlNone
.Font.Color = vbBlack
End Select
ElseIf bLowest = True Then
'Select Case CDbl(.Text)
Select Case .Value
Case Is = ""
.Interior.Color = xlNone
.Font.Color = vbBlack
Case Is = tTimes(i, 2)
.Interior.Color = vbYellow
.Font.Color = vbRed
Case Is <= tTimes(i, 1)
.Interior.Color = vbGreen
.Font.Color = vbRed
Case Else
.Interior.Color = xlNone
.Font.Color = vbBlack
End Select
End If
End With
End If
Next c
Next i
Next k
Application.ScreenUpdating = True
End Sub

 

[Sam Harman]

Thanks Ron - have sent

Sam

Sam,

I am going out of town in an hour, and do not have time to look into this now. If you could post or email me a copy of the errant workbook, with a clear explanation of what you mean by "not working properly", it would simplify the troubleshooting process when I return. To email me, use "mo c TO D e ni l no d le f ne s or T An o r " , remove the spaces, reverse it and make the obvious substitutions.