Last active
August 29, 2015 14:24
-
-
Save airstrike/d2a71a1da89a03d8f6da to your computer and use it in GitHub Desktop.
DeleteUnusedCustomNumberFormats
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
'Credits to Leo Heuser, as posted by Ivan Moala at http://www.mrexcel.com/archive/VBA/5160.html | |
Sub DeleteUnusedCustomNumberFormats() | |
Dim Buffer As Object | |
Dim Sh As Object | |
Dim SaveFormat As Variant | |
Dim fFormat As Variant | |
Dim nFormat() As Variant | |
Dim xFormat As Long | |
Dim Counter As Long | |
Dim Counter1 As Long | |
Dim Counter2 As Long | |
Dim StartRow As Long | |
Dim EndRow As Long | |
Dim Dummy As Variant | |
Dim pPresent As Boolean | |
Dim NumberOfFormats As Long | |
Dim Answer | |
Dim c As Object | |
Dim DataStart As Long | |
Dim DataEnd As Long | |
Dim AnswerText As String | |
NumberOfFormats = 1000 | |
ReDim nFormat(0 To NumberOfFormats) | |
AnswerText = "Do you want to delete unused custom formats from the workbook?" | |
AnswerText = AnswerText & Chr(10) & "To get a list of used and unused formats only, choose No." | |
Answer = MsgBox(AnswerText, 259) | |
If Answer = vbCancel Then GoTo Finito | |
Application.ScreenUpdating = False | |
On Error GoTo Finito | |
Worksheets.Add.Move after:=Worksheets(Worksheets.Count) | |
Worksheets(Worksheets.Count).Name = "CustomFormats" | |
Worksheets("CustomFormats").Activate | |
Set Buffer = Range("A2") | |
Buffer.Select | |
nFormat(0) = Buffer.NumberFormatLocal | |
Counter = 1 | |
Do | |
SaveFormat = Buffer.NumberFormatLocal | |
Dummy = Buffer.NumberFormatLocal | |
DoEvents | |
SendKeys "{tab 3}{down}{enter}" | |
Application.Dialogs(xlDialogFormatNumber).Show Dummy | |
nFormat(Counter) = Buffer.NumberFormatLocal | |
Counter = Counter + 1 | |
Loop Until nFormat(Counter - 1) = SaveFormat | |
ReDim Preserve nFormat(0 To Counter - 2) | |
Range("A1").Value = "Custom formats" | |
Range("B1").Value = "Formats used in workbook" | |
Range("C1").Value = "Formats not used" | |
Range("A1:C1").Font.Bold = True | |
StartRow = 3 | |
EndRow = 16384 | |
For Counter = 0 To UBound(nFormat) | |
Cells(StartRow, 1).Offset(Counter, 0).NumberFormatLocal = nFormat(Counter) | |
Cells(StartRow, 1).Offset(Counter, 0).Value = nFormat(Counter) | |
Next Counter | |
Counter = 0 | |
For Each Sh In ActiveWorkbook.Worksheets | |
If Sh.Name = "CustomFormats" Then Exit For | |
For Each c In Sh.UsedRange.Cells | |
fFormat = c.NumberFormatLocal | |
If Application.WorksheetFunction.CountIf(Range(Cells(StartRow, 2), Cells(EndRow, 2)), fFormat) = 0 Then | |
Cells(StartRow, 2).Offset(Counter, 0).NumberFormatLocal = fFormat | |
Cells(StartRow, 2).Offset(Counter, 0).Value = fFormat | |
Counter = Counter + 1 | |
End If | |
Next c | |
Next Sh | |
xFormat = Range(Cells(StartRow, 2), Cells(EndRow, 2)).Find("").Row - 2 | |
Counter2 = 0 | |
For Counter = 0 To UBound(nFormat) | |
pPresent = False | |
For Counter1 = 1 To xFormat | |
If nFormat(Counter) = Cells(StartRow, 2).Offset(Counter1, 0).NumberFormatLocal Then | |
pPresent = True | |
End If | |
Next Counter1 | |
If pPresent = False Then | |
Cells(StartRow, 3).Offset(Counter2, 0).NumberFormatLocal = nFormat(Counter) | |
Cells(StartRow, 3).Offset(Counter2, 0).Value = nFormat(Counter) | |
Counter2 = Counter2 + 1 | |
End If | |
Next Counter | |
With ActiveSheet.Columns("A:C") | |
.AutoFit | |
.HorizontalAlignment = xlLeft | |
End With | |
If Answer = vbYes Then | |
DataStart = Range(Cells(1, 3), Cells(EndRow, 3)).Find("").Row + 1 | |
DataEnd = Cells(DataStart, 3).Resize(EndRow, 1).Find("").Row - 1 | |
On Error Resume Next | |
For Each c In Range(Cells(DataStart, 3), Cells(DataEnd, 3)).Cells | |
ActiveWorkbook.DeleteNumberFormat (c.NumberFormat) | |
Next c | |
End If | |
Finito: | |
Application.ScreenUpdating = True | |
Set c = Nothing | |
Set Sh = Nothing | |
Set Buffer = Nothing | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment