Renewed Thanks for that, Gord!

It happens that I have not yet tried it, so your posting is both apposite
and timely, and clearly obviates the disappointment that I might have had in
it not succeeding.
I shall try it within the next half-hour.

Very Best Wishes,

Kit Driver

"Gord Dibben" wrote:

Kit

Just a note of caution here.

The line wraps in Tom's posting leave a bit of editing to do.

I will re-post with line-continuation characters inserted.

Those are the _ symbols

Sub ListCondFmt()
'Declare local variables.
Dim x As Long, Rng As Range, Rx As String, Hits As Long
Dim NewWS As Worksheet, StartWS As Worksheet
Hits& = 1
Set StartWS = ActiveSheet
'Add a new worksheet to the current workbook at the end.
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
Set NewWS = ActiveSheet
StartWS.Activate
'Find last (highest row/col) cell used on sheet.
On Error Resume Next
ActiveSheet.UsedRange
lastcell$ = FindLastCell(ActiveSheet)
'If FindLastCell() returned ERROR, set lastCell to A1 (empty sheet?)
If lastcell$ = "ERROR" Then
lastcell$ = "A1"
End If
On Error GoTo LCFerr1
'Select all cells from A1 through the last cell.
ActiveWorkbook.Sheets(ActiveSheet.Name).Range("A1: " & lastcell$).Select
For Each Rng In Selection
If Rng.FormatConditions.Count 0 Then
Hits& = Hits& + 1
For x = 1 To Rng.FormatConditions.Count
If Rng.FormatConditions(x).Type = 1 Then
Select Case Rng.FormatConditions(x).Operator
Case 1:
Rx$ = "Between " & _
Rng.FormatConditions(x).Formula1 & " and " & _
Rng.FormatConditions(x).Formula2
Case 2:
Rx$ = "Not between " & _
Rng.FormatConditions(x).Formula1 & " and " & _
Rng.FormatConditions(x).Formula2
Case 3:
Rx$ = "Equal to " & _
Rng.FormatConditions(x).Formula1
Case 4:
Rx$ = "Not equal to " & _
Rng.FormatConditions(x).Formula1
Case 5:
Rx$ = "Greater than " & _
Rng.FormatConditions(x).Formula1
Case 6:
Rx$ = "Less than " & _
Rng.FormatConditions(x).Formula1
Case 7:
Rx$ = "Greater than or equal to " & _
Rng.FormatConditions(x).Formula1
Case 8:
Rx$ = "Less than or equal to " & _
Rng.FormatConditions(x).Formula1
Case Else
Rx$ = "Unknown operator " & _
Rng.FormatConditions(x).Operator
End Select
ElseIf Rng.FormatConditions(x).Type = 2 Then
Rx$ = Rng.FormatConditions(x).Formula1
Else
Rx$ = "Unknown type"
End If
If x = 1 Then
NewWS.Cells(Hits&, 1).Value = "'" & StartWS.Name
NewWS.Cells(Hits&, 2).Value = "'" & Rng.Address
End If
NewWS.Cells(Hits&, x + 2).Value = "'" & Rx$
Next x
End If
Next Rng
'If no cells were found, tell user & delete the new sheet.
If Hits& = 1 Then
MsgBox "No cells with conditional formatting were found", _
vbInformation, "ListCondFmt"
Application.DisplayAlerts = False
NewWS.Delete
Application.DisplayAlerts = True
GoTo Cleanup1
End If
'Add headings for the output rows.
NewWS.Cells(1, 1).Value = "Sheet"
NewWS.Cells(1, 2).Value = "Cell"
NewWS.Cells(1, 3).Value = "Condition1"
NewWS.Cells(1, 4).Value = "Condition2"
NewWS.Cells(1, 5).Value = "Condition3"
'Resize all columns on NewWS.
NewWS.Activate
Cells.Select
Cells.EntireColumn.AutoFit
Cleanup1:
'Free object variables.
Set NewWS = Nothing
Set StartWS = Nothing
'Restore the cursor.
Application.Cursor = xlDefault
Exit Sub
LCFerr1:
If Err.Number < 0 Then
msg1$ = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox msg1$, , "ListCondFmt error", Err.HelpFile, Err.HelpContext
End If
GoTo Cleanup1
End Sub

Function FindLastCell(Wksht As Worksheet) As String
'Returns address of last cell used (highest row & col) on specified sheet
Dim LastRow As Long
Dim LastCol As Integer
On Error GoTo FLCerr1
With Wksht
LastRow = 0
LastCol = 0
LastRow& = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
LastCol% = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column
End With
FindLastCell$ = Cells(LastRow&, LastCol%).AddressLocal
Exit Function
FLCerr1:
FindLastCell$ = "ERROR"
End Function



Gord



On Tue, 11 Jul 2006 09:42:01 -0700, Kit wrote:

As the instigator of this query, I must thank you, Tom, very much.
I have only just received notification of replies, and am mightily impressed
by the look of the code, which is beyond my comprehension (I used to be a
whizz at BASIC!!), but have not yet copied it into the appropriate place to
try, but I trust Gord Dibben's verdict,as he must have trested it - and of
course you own, who had obviously tried and tested it before posting. It will
be used for a voluntary organisation whose rota I arrange. It should result
in fool-proof operation of the EXCEL sheet for that purpose. Many thanks all
round. I intend to report back when I have tried it.

Best Wishes,

Kit

"Gord Dibben" wrote:

Tom

Works a charm.

Glad to have the code.


Gord Dibben MS Excel MVP

On Mon, 10 Jul 2006 13:30:02 -0700, Tom Hutchins
wrote:


Here's a subroutine which lists the conditional formatting conditions for
every cell on the active sheet on a new sheet at the end of the workbook.

Sub ListCondFmt()
'Declare local variables.
Dim x As Long, Rng As Range, Rx As String, Hits As Long
Dim NewWS As Worksheet, StartWS As Worksheet
Hits& = 1
Set StartWS = ActiveSheet
'Add a new worksheet to the current workbook at the end.
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
Set NewWS = ActiveSheet
StartWS.Activate
'Find last (highest row/col) cell used on sheet.
On Error Resume Next
ActiveSheet.UsedRange
LastCell$ = FindLastCell(ActiveSheet)
'If FindLastCell() returned ERROR, set lastCell to A1 (empty sheet?)
If LastCell$ = "ERROR" Then
LastCell$ = "A1"
End If
On Error GoTo LCFerr1
'Select all cells from A1 through the last cell.
ActiveWorkbook.Sheets(ActiveSheet.Name).Range("A1: " & LastCell$).Select
For Each Rng In Selection
If Rng.FormatConditions.Count 0 Then
Hits& = Hits& + 1
For x = 1 To Rng.FormatConditions.Count
If Rng.FormatConditions(x).Type = 1 Then
Select Case Rng.FormatConditions(x).Operator
Case 1:
Rx$ = "Between " &
Rng.FormatConditions(x).Formula1 & " and " & Rng.FormatConditions(x).Formula2
Case 2:
Rx$ = "Not between " &
Rng.FormatConditions(x).Formula1 & " and " & Rng.FormatConditions(x).Formula2
Case 3:
Rx$ = "Equal to " &
Rng.FormatConditions(x).Formula1
Case 4:
Rx$ = "Not equal to " &
Rng.FormatConditions(x).Formula1
Case 5:
Rx$ = "Greater than " &
Rng.FormatConditions(x).Formula1
Case 6:
Rx$ = "Less than " &
Rng.FormatConditions(x).Formula1
Case 7:
Rx$ = "Greater than or equal to " &
Rng.FormatConditions(x).Formula1
Case 8:
Rx$ = "Less than or equal to " &
Rng.FormatConditions(x).Formula1
Case Else
Rx$ = "Unknown operator " &
Rng.FormatConditions(x).Operator
End Select
ElseIf Rng.FormatConditions(x).Type = 2 Then
Rx$ = Rng.FormatConditions(x).Formula1
Else
Rx$ = "Unknown type"
End If
If x = 1 Then
NewWS.Cells(Hits&, 1).Value = "'" & StartWS.Name
NewWS.Cells(Hits&, 2).Value = "'" & Rng.Address
End If
NewWS.Cells(Hits&, x + 2).Value = "'" & Rx$
Next x
End If
Next Rng
'If no cells were found, tell user & delete the new sheet.
If Hits& = 1 Then
MsgBox "No cells with conditional formatting were found",
vbInformation, "ListCondFmt"
Application.DisplayAlerts = False
NewWS.Delete
Application.DisplayAlerts = True
GoTo Cleanup1
End If
'Add headings for the output rows.
NewWS.Cells(1, 1).Value = "Sheet"
NewWS.Cells(1, 2).Value = "Cell"
NewWS.Cells(1, 3).Value = "Condition1"
NewWS.Cells(1, 4).Value = "Condition2"
NewWS.Cells(1, 5).Value = "Condition3"
'Resize all columns on NewWS.
NewWS.Activate
Cells.Select
Cells.EntireColumn.AutoFit
Cleanup1:
'Free object variables.
Set NewWS = Nothing
Set StartWS = Nothing
'Restore the cursor.
Application.Cursor = xlDefault
Exit Sub
LCFerr1:
If Err.Number < 0 Then
msg1$ = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox msg1$, , "ListCondFmt error", Err.HelpFile, Err.HelpContext
End If
GoTo Cleanup1
End Sub

Function FindLastCell(Wksht As Worksheet) As String
'Returns address of last cell used (highest row & col) on specified sheet
Dim LastRow As Long
Dim LastCol As Integer
On Error GoTo FLCerr1
With Wksht
LastRow = 0
LastCol = 0
LastRow& = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
LastCol% = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchDirection:=xlPrevious, _