I've reworked Leo's code:

- skipped the documentation part...
- rather than add a worksheet I've tried to remain within VBA
as much as possible.
- reduced window jittering

To make it perfect I should expand UsedFormats to search for
numberformat's used in Styles,Pivots and Graphs..

(coding for xlXP+ it could more efficient... cause FindFormats can be
used)


I haven't extensively tested it...
but let me know what you think..




Option Explicit
Option Base 0

'USER32
Private Declare Function GetDesktopWindow _
Lib "user32" () As Long
Private Declare Function LockWindowUpdate _
Lib "user32" (ByVal hwndLock As Long) As Long


Sub ClearUnusedNumberFormats()
Dim cUsed As Collection
Dim cDefi As Collection
Dim cKill As Collection
Dim cSkip As Collection

Dim vItm As Variant
Dim sMsg As String

Set cUsed = UsedNumberFormats
Set cDefi = DefinedNumberFormats
Set cKill = New Collection
Set cSkip = New Collection

On Error Resume Next
For Each vItm In cDefi
If IsError(cUsed(vItm(1))) Then
Err.Clear
ActiveWorkbook.DeleteNumberFormat vItm(0)
If Err = 0 Then cKill.Add vItm Else cSkip.Add vItm
End If
Next

For Each vItm In cKill
sMsg = sMsg & vItm(1) & vbNewLine
Next
If sMsg = "" Then sMsg = "None..."
MsgBox sMsg, , "Deleted NumberFormats"


End Sub


Function UsedNumberFormats( _
Optional wkb As Workbook) As Collection
Dim cRes As Collection
Dim wks As Worksheet
Dim rng As Range


If wkb Is Nothing Then Set wkb = ActiveWorkbook

Set cRes = New Collection

On Error Resume Next
For Each wks In wkb.Worksheets
For Each rng In wks.UsedRange.Cells
cRes.Add Array(rng.NumberFormat, _
rng.NumberFormatLocal), rng.NumberFormatLocal
Next
Next
Set UsedNumberFormats = cRes
End Function


Function DefinedNumberFormats( _
Optional wkb As Workbook) As Collection
'Reworked from Leo Heusers original approach :)

Dim cRes As Collection
Dim rng(0 To 1) As Range
Dim sGen As String

Set cRes = New Collection
sGen = Application.International(xlGeneralFormatName)

If wkb Is Nothing Then Set wkb = ActiveWorkbook Else _
wkb.Activate

'Find a blank cell with General numberformat
With ActiveSheet.Cells
Set rng(0) = ActiveCell
Set rng(1) = .Find("", rng(0))
If rng(1) Is Nothing Then Set rng(1) = rng(0)
While rng(0).Address < rng(1).Address And rng( _
1).NumberFormatLocal < sGen
Set rng(1) = .FindNext(rng(1))
Wend
End With
If rng(1).NumberFormatLocal < sGen Then Exit Function
rng(1).Select

'Loop Thru the Dialog
cRes.Add Array(rng(1).NumberFormat, _
rng(1).NumberFormatLocal), rng(1).NumberFormatLocal
Application.Top = Application.Top - 5000
LockWindowUpdate GetDesktopWindow

On Error GoTo done
Do
DoEvents
SendKeys "{tab 3}{down}{enter}"
Application.Dialogs(xlDialogFormatNumber).Show cRes( _
cRes.Count)(1)
cRes.Add Array(rng(1).NumberFormat, _
rng(1).NumberFormatLocal), rng(1).NumberFormatLocal
Loop

done:

rng(1).NumberFormat = "General"
Set DefinedNumberFormats = cRes
LockWindowUpdate False
Application.Top = Application.Top + 5000


End Function




keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


GatesAntichrist wrote:

( DeleteUnusedCustomNumberFormats() , May 6.
2001)
Leo's fine code seems to still hold up but has a killer problem,
simulated below:
In XL2002, start a fresh sheet. "General" should be the default cell
format.
Type the mere digit 0 in cell A1. It ought to look like a 0, and be
General format.
A2 =COUNTIF(A1:A1,"0.0%")
A2 gets a 1 … ouch.

Those of you USENET vets who are in harmony with the code and Leo can
see how this gives a false negative, ruining the results. The
Application.COUNTIF here "tells" the code that "0.0%" is already shown
in the "formats being used" column list, though it isn't; it never
makes it in the "used" column and ultimately shows as unused. It is
not warm and fuzzy when you delete the format relying on that info!

Now for those of you that don't have the code or don't recall it or
don't follow along with the above paragraph:
1. Is this behavior new with XL2002? (that the countif returns 1 and
not 0)
2. Is COUNTIF really looking for text, or is it cleverly
type-converting? Can I "cast" somehow to subvert that?
3. Is the way out of this mess to use .Find method? Or
Application.[something else]?

TIA


---
Message posted from http://www.ExcelForum.com/