PDA

View Full Version : List ALL Formulas & Conditional Formatting in a WorkBook



PAB
01-30-2012, 12:14 PM
Good evening,

Does anyone know of a good VBA code to list ALL the formulas and conditional formatting in a WorkBook please?
Ideally the code would create a new WorkSheet and then the results would give :-

The WorkSheet Name
The Cell Reference
The Formula in that Cell
The Conditional Formatting in that Cell

I have looked on the WWW but can't seem to find anything suitable.
Thanks in advance.

Regards,
PAB

Kenneth Hobs
01-31-2012, 07:11 AM
I am not sure how you would do both other than a many line text value per cell in the other workbook using VBA.

With 2007+, there can be many conditional formats per cell.

Showing the formulas is already one of the Advanced Display Options that you can select.

I guess you can post simple before and after workbooks to show what you want.

PAB
01-31-2012, 10:42 AM
Thanks for the reply Kenneth,

Actually, thinking about it, the above requirements without the Conditional Formatting will suffice.
As I said previously, the code would create a new WorkSheet and then the results would give :-

The WorkSheet Name
The Cell Reference
The Formula in that Cell

I can then manipulate the data as necessary.
Thanks in advance.

Regards,
PAB

xld
01-31-2012, 11:48 AM
Off the top



Dim sh As Worksheet
Dim cell As Range
Dim nextrow As Long

Application.ScreenUpdating = False

With ActiveWorkbook

.Worksheets.Add After:=.Worksheets(.Worksheets.Count)
With .ActiveSheet

.Name = "Formula List"
.Range("A1:C1").Value = Array("Sheet", "Cell", "Formula")
nextrow = 1

For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> "Formula List" Then

For Each cell In sh.UsedRange

If cell.HasFormula Then

nextrow = nextrow + 1
.Cells(nextrow, "A").Value = sh.Name
.Cells(nextrow, "B").Value = cell.Address
.Cells(nextrow, "C").Value = "'" & cell.Formula
End If
Next cell
End If

If .Cells(nextrow, "A").Value = sh.Name Then nextrow = nextrow + 1
Next sh

.Columns("A:C").AutoFit
End With
End With

Application.ScreenUpdating = True

PAB
01-31-2012, 12:30 PM
Brilliant xld,

Works like a dream and is so useful and time saving.
I will do some investigating and see if I can adapt it to include Conditional Formatting.
Thanks again.

Regards,
PAB

xld
01-31-2012, 12:47 PM
Be warned, conditional formatting is hard, because there can be more than one, and extracting the properties is not obvious.

This may give you a start http://www.xldynamic.com/source/xld.CFConditions.html, but it may just confuse you.

PAB
01-31-2012, 01:50 PM
Hi xld,

I see what you mean, I think I will forget trying to do that as it is not that important.
One question please, because I will probably use this code for several or more WorkBooks at one time or another I have tried to adapt the code so that if the sheet doesn't exist it creates it (this is not working in the adapted code below) and if it does exist it deletes the WorkSheet ("Formula List") and recreates it (this is working in the adapted code). I tried ...
If Not Sheets("Formula List") Is Nothing Then
... as well as what I have got in the adapted code.

Option Explicit
Sub ListAllFormulas()
Dim sh As Worksheet
Dim cell As Range
Dim nextrow As Long
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
With ActiveWorkbook



If Sheets("Formula List").Name = False Then
.Worksheets.Add After:=.Worksheets(.Worksheets.Count)
Else
Sheets("Formula List").Select
ActiveWindow.SelectedSheets.Delete
End If



With .ActiveSheet
.Name = "Formula List"
.Range("A1:C1").Value = Array("Sheet", "Cell", "Formula")
nextrow = 1
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> "Formula List" Then
For Each cell In sh.UsedRange
If cell.HasFormula Then
nextrow = nextrow + 1
.Cells(nextrow, "A").Value = sh.Name
.Cells(nextrow, "B").Value = cell.Address
.Cells(nextrow, "C").Value = "'" & cell.Formula
End If
Next cell
End If
If .Cells(nextrow, "A").Value = sh.Name Then nextrow = nextrow + 1
Next sh
.Columns("A:C").AutoFit
.Rows.AutoFit
.Columns("A:C").VerticalAlignment = xlTop
End With
End With
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub
Have you got any ideas please?
Thanks in advance.

Regards,
PAB

PAB
01-31-2012, 02:10 PM
Hi xld,

Don't worry, I have used ...

With ActiveWorkbook
On Error Resume Next
Sheets("Formula List").Delete
On Error GoTo 0
.Worksheets.Add After:=.Worksheets(.Worksheets.Count)
With .ActiveSheet
... which seems to do the job.
Thanks.

Regards,
PAB

xld
01-31-2012, 06:11 PM
Her is another way



Dim sh As Worksheet
Dim cell As Range
Dim nextrow As Long

Application.ScreenUpdating = False

With ActiveWorkbook

On Error Resume Next
Set sh = .Worksheets("Formula List")
On Error GoTo 0
If sh Is Nothing Then

.Worksheets.Add After:=.Worksheets(.Worksheets.Count)
.ActiveSheet.Name = "Formula List"
Else

sh.Cells.ClearContents
End If

With .Worksheets("Formula List")


.Range("A1:C1").Value = Array("Sheet", "Cell", "Formula")
nextrow = 1

For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> "Formula List" Then

For Each cell In sh.UsedRange

If cell.HasFormula Then

nextrow = nextrow + 1
.Cells(nextrow, "A").Value = sh.Name
.Cells(nextrow, "B").Value = cell.Address
.Cells(nextrow, "C").Value = "'" & cell.Formula
End If
Next cell
End If

If .Cells(nextrow, "A").Value = sh.Name Then nextrow = nextrow + 1
Next sh

.Columns("A:C").AutoFit
End With
End With

Application.ScreenUpdating = True

PAB
01-31-2012, 06:32 PM
Thanks for the updated version xld.
Is your way better coding practice than mine, and if so why please?
I am always willing to learn.
Thanks very much.

Regards,
PAB

PAB
01-31-2012, 06:46 PM
Hi xld,

I just ran your amended code and it took twice as long as the updated code I posted above. The thing with my code as opposed to your code that I noticed is my code deletes the current "Sheet" number and increases the "Sheet" number by one in the VBAProject.
Anyway, thanks for ALL your help.

Regards,
PAB