Home |
Search |
Today's Posts |
#1
|
|||
|
|||
How do I determine the number of cell formats in this workbook
How do I determine the number of cell formats in this workbook
|
#2
|
|||
|
|||
How do I determine the number of cell formats in this workbook
I have an Excel addin that performs that task. Email me for it at
************ Anne Troy www.OfficeArticles.com "tucsonmissiledude" wrote in message ... How do I determine the number of cell formats in this workbook |
#3
|
|||
|
|||
How do I determine the number of cell formats in this workbook
Hi TucsonMissileDude,
Try the following code from Leo Heuser. To delete unused formats, answer 'yes' to the imitial message box; ansewring 'no' will retain all exising formats but will produce a report listing: '============================= Sub DeleteUnusedCustomNumberFormats() , May 6. 2001 'Version 1.01 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 pPresent As Boolean Dim NumberOfFormats As Long Dim Answer Dim Cell As Object Dim DataStart As Long Dim DataEnd As Long Dim AnswerText As String Dim ActWorkbookName As String Dim BufferWorkbookName As String NumberOfFormats = 1000 StartRow = 3 ' Do not alter this value EndRow = Rows.Count 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 On Error GoTo Finito ActWorkbookName = ActiveWorkbook.Name Workbooks.Add BufferWorkbookName = ActiveWorkbook.Name Set Buffer = Workbooks(BufferWorkbookName). _ ActiveSheet.Range("A3") nFormat(0) = Buffer.NumberFormatLocal Buffer.NumberFormat = "@" Buffer.Value = nFormat(0) Workbooks(ActWorkbookName).Activate Counter = 1 Do SaveFormat = Buffer.Value DoEvents SendKeys "{TAB 3}" For Counter1 = 1 To Counter SendKeys "{DOWN}" Next Counter1 SendKeys "+{TAB}{HOME}'{HOME}+{END}" _ & "^C{TAB 4}{ENTER}" Application.Dialogs(xlDialogFormatNumber). _ Show nFormat(0) ActiveSheet.Paste Destination:=Buffer Buffer.Value = Mid(Buffer.Value, 2) nFormat(Counter) = Buffer.Value Counter = Counter + 1 Loop Until nFormat(Counter - 1) = SaveFormat ReDim Preserve nFormat(0 To Counter - 2) Workbooks(BufferWorkbookName).Activate Range("A1").Value = "Custom formats" Range("B1").Value = "Formats used in workbook" Range("C1").Value = "Formats not used" Range("A1:C1").Font.Bold = True 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 Workbooks(ActWorkbookName).Worksheets For Each Cell In Sh.UsedRange.Cells fFormat = Cell.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 Cell 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 Cell In Range(Cells(DataStart, 3), _ Cells(DataEnd, 3)).Cells Workbooks(ActWorkbookName).DeleteNumberFormat _ (Cell.NumberFormat) Next Cell End If Finito: Set Cell = Nothing Set Sh = Nothing Set Buffer = Nothing End Sub '<<============================= --- Regards, Norman "tucsonmissiledude" wrote in message ... How do I determine the number of cell formats in this workbook |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Count Number of Characters in a cell? | Excel Discussion (Misc queries) | |||
Linking a cell to another workbook cell based on a variable name | Excel Discussion (Misc queries) | |||
Reveal cell formats and extendable range in tool/statusbar/icon. | Excel Worksheet Functions | |||
Changing Cell formats to date fields automatically | Excel Worksheet Functions | |||
Function to determine if any cell in a range is contained in a given cell | Excel Worksheet Functions |