Something I found on the web:
Worked for me
Thanks.
Seb
============================================
Sub DeleteFormats()
Dim strOldFormat As String
Dim strNewFormat As String
Dim aCell As range
Dim sht As Worksheet
Dim strFormats() As String
Dim fFormatsUsed() As Boolean
Dim i As Integer, j As Integer, k As Integer
If ActiveWorkbook.Worksheets.Count = 0 Then
MsgBox "The active workbook contains no worksheets.", vbInformation
Exit Sub
End If
On Error GoTo Exit_Sub
Application.Cursor = xlWait
ReDim strFormats(1000)
ReDim fFormatsUsed(1000)
Set aCell = range("A1")
aCell.Select
strOldFormat = aCell.NumberFormatLocal
aCell.NumberFormat = "General"
strFormats(0) = "General"
strNewFormat = aCell.NumberFormatLocal
i = 1
Do
' Dialog box requires local format
SendKeys "{TAB 3}{DOWN}{ENTER}"
Application.Dialogs(xlDialogFormatNumber).Show strNewFormat
strFormats(i) = aCell.NumberFormat
strNewFormat = aCell.NumberFormatLocal
i = i + 1
Loop Until strFormats(i - 1) = strFormats(i - 2)
aCell.NumberFormatLocal = strOldFormat
ReDim Preserve strFormats(i - 2)
ReDim Preserve fFormatsUsed(i - 2)
For Each sht In ActiveWorkbook.Worksheets
For Each aCell In sht.UsedRange
For i = 0 To UBound(strFormats)
If aCell.NumberFormat = strFormats(i) Then
fFormatsUsed(i) = True
Exit For
End If
Next i
Next aCell
Next sht
' Prevent error on built-in formats
On Error Resume Next
For i = 0 To UBound(strFormats)
If Not fFormatsUsed(i) Then
' DeleteNumberFormat requires international format
ActiveWorkbook.DeleteNumberFormat strFormats(i)
End If
Next i
Exit_Sub:
Set aCell = Nothing
Set sht = Nothing
Erase strFormats
Erase fFormatsUsed
Application.Cursor = xlDefault
End Sub