Solved

VBA to clear custom formats from Excel

Posted on 2002-06-12
7
2,636 Views
Last Modified: 2007-12-19
I have recorded a simple maco to clean out unnecessary formats that have been accumulating and build-up when worksheets are moved/copied between workbooks.

Sub ClearDumbFormats()
' ClearDumbFormats Macro
' Macro recorded 5/13/02

    ActiveWorkbook.DeleteNumberFormat NumberFormat:= _
    "_(* #,##0.00000000000_);_(* (#,##0.00000000000);_    (* ""-""??_);_(@_)"
    ActiveWorkbook.DeleteNumberFormat NumberFormat:= _
        "_(* #,##0.0000000_);_(* (#,##0.0000000);_(* ""-""??_);_(@_)"

etc... for many, many more..

It worked the first time I ran it, but when run in a workbook w/o the specified format, I get a run time error.  I want VBA to check and see if the format exist, and if it does, delete it. If it does not, move on to the next line of code all through the formats I have identified to be deleted.

How do I need to structure my code?

Thanks,
Mark
0
Comment
Question by:meremark
  • 4
  • 3
7 Comments
 
LVL 44

Expert Comment

by:bruintje
ID: 7073455
Hi Meremark,

remember you aksing a similar question 2 months ago or so?

here are two procedures from another thread is was part of

---------------
cleanup formats
---------------

The below routine will remove all unused custom numberformats from the workbook. The flickering dialogbox
is supposed to flicker :-) The routine adds a sheet to the workbook, which lists Custom formats", "Formats
used in
workbook" and "Formats not used"

Best regards
LeoH

Sub DeleteUnusedCustomNumberFormats()
'leo.heuser@get2net.dk May 1999
'For Windows only
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

   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:
Set c = Nothing
Set Sh = Nothing
Set Buffer = Nothing
End Sub


--------------
cleanup styles
--------------


The Styles are just collections of formats, and even if you delete a custom *number* format, the styles
containing that format will not be deleted. The number format in the
style will merely be changed to "Standard". To delete all unused styles try the sub below. It will also
delete the default styles (except "Normal"), if they are not used in the workbook. If you want them
back, the easiest way is to open a new workbook (say Book2), activate the original workbook, choose
Format > Styles, push the merge button and choose Book2.

Best regards
LeoH

Sub DeleteUnusedStyles()
'leo.heuser@get2net.dk November 1999
Dim Sh As Object
Dim sStyle As Variant
Dim nStyle() As Variant
Dim xStyle 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 Answer
Dim c As Object
Dim DataStart As Long
Dim DataEnd As Long
Dim AnswerText As String
ReDim nStyle(1 To ActiveWorkbook.Styles.Count)

   AnswerText = "Do you want to delete unused styles from the workbook?"
   AnswerText = AnswerText & Chr(10) & "To get a list of used and unused
styles only, choose No."
   Answer = MsgBox(AnswerText, 259)
   If Answer = vbCancel Then GoTo Finito

   On Error GoTo Finito
   Worksheets.Add.Move After:=Worksheets(Worksheets.Count)
   Worksheets(Worksheets.Count).Name = "CustomStyles"
   Worksheets("CustomStyles").Activate
   For Counter = 1 To ActiveWorkbook.Styles.Count
       nStyle(Counter) = ActiveWorkbook.Styles(Counter).Name
   Next Counter

   Range("A1").Value = "Styles"
   Range("B1").Value = "Styles used in workbook"
   Range("C1").Value = "Styles not used"
   Range("A1:C1").Font.Bold = True

   StartRow = 3
   EndRow = 16384

   For Counter = 1 To UBound(nStyle)
       Cells(StartRow, 1).Offset(Counter - 1, 0).Value = nStyle(Counter)
   Next Counter

   Counter = 0
   For Each Sh In ActiveWorkbook.Worksheets
       If Sh.Name = "CustomStyles" Then Exit For
       For Each c In Sh.UsedRange.Cells
           sStyle = c.Style.Name
           If Application.WorksheetFunction.CountIf(Range(Cells(StartRow,
2), Cells(EndRow, 2)), sStyle) = 0 Then
               Cells(StartRow, 2).Offset(Counter, 0).Value = sStyle
               Counter = Counter + 1
           End If
       Next c
   Next Sh

   xStyle = Range(Cells(StartRow, 2), Cells(EndRow, 2)).Find("").Row - 2

   Counter2 = 0
   For Counter = 1 To UBound(nStyle)
       pPresent = False
       For Counter1 = 1 To xStyle
           If nStyle(Counter) = Cells(StartRow, 2).Offset(Counter1 - 1,
0).Value Then
               pPresent = True
               Exit For
           End If
       Next Counter1
       If pPresent = False Then
           Cells(StartRow, 3).Offset(Counter2, 0).Value = nStyle(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.Styles(c.Value).Delete
       Next c
   End If
Finito:
Set c = Nothing
Set Sh = Nothing
End Sub


just let me know if you need some help with it

HAGD:O)Bruintje

0
 

Author Comment

by:meremark
ID: 7073981
Bruintje

Thank you for your response.

You are correct.  2 months ago you helped me deleted the custom formats contained in the cells of the worksheets.  Now it is time to delete the custom formats saved in the workbook.

I copied the first sub you have listed into my file and ran it.  After 15 minutes of clocking, I ctrl-break’d the sub.  I put it into a “blank” workbook that I added about 20 custom formats to and ran it, and it worked fine.  So I tried it on my intended file a second time and once again need to break it after 10 minutes.

I manage the production of a 100+ page report produced in Excel.  Many of the worksheets are sourced through me, but a large percent are not, and all I do is moved the worksheet from the source file into my master file.  When I do this, I get a dialog box for each format that can’t be added indicating no more custom formats can be added.  Sometimes I might get 5 or 6 dialog boxes for each worksheet moved.

Although your sub is nice, it is not a good solution for what I need: 1) I need a fast sub.  2) I only need to delete enough custom formats to avoid the dialog box (Ockham's razor) 3) I do not need to know what formats are in the workbook or if use/unused. 4) I know the 20-30 formats I want to delete to avoid the dialog box.  5) I have no control of the front end, so this is back end maintenance. 6) These are large files and I need a fast sub - so important it is listed twice ;-)

That is why I was thinking of an IF statement.  If the custom format exists delete it; otherwise move to the next line of code.  I just do not know how to set it up.

Thanks,
Mark
0
 

Author Comment

by:meremark
ID: 7073982
Bruintje

Thank you for your response.

You are correct.  2 months ago you helped me deleted the custom formats contained in the cells of the worksheets.  Now it is time to delete the custom formats saved in the workbook.

I copied the first sub you have listed into my file and ran it.  After 15 minutes of clocking, I ctrl-break’d the sub.  I put it into a “blank” workbook that I added about 20 custom formats to and ran it, and it worked fine.  So I tried it on my intended file a second time and once again need to break it after 10 minutes.

I manage the production of a 100+ page report produced in Excel.  Many of the worksheets are sourced through me, but a large percent are not, and all I do is moved the worksheet from the source file into my master file.  When I do this, I get a dialog box for each format that can’t be added indicating no more custom formats can be added.  Sometimes I might get 5 or 6 dialog boxes for each worksheet moved.

Although your sub is nice, it is not a good solution for what I need: 1) I need a fast sub.  2) I only need to delete enough custom formats to avoid the dialog box (Ockham's razor) 3) I do not need to know what formats are in the workbook or if use/unused. 4) I know the 20-30 formats I want to delete to avoid the dialog box.  5) I have no control of the front end, so this is back end maintenance. 6) These are large files and I need a fast sub - so important it is listed twice ;-)

That is why I was thinking of an IF statement.  If the custom format exists delete it; otherwise move to the next line of code.  I just do not know how to set it up.

Thanks,
Mark
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 44

Accepted Solution

by:
bruintje earned 200 total points
ID: 7074924
Hi Mark,

then to answer your question

Sub ClearDumbFormats()

On Error GoTo errhandle

  ActiveWorkbook.DeleteNumberFormat NumberFormat:= _
  "_(* #,##0.00000000000_);_(* (#,##0.00000000000);_    (* ""-""??_);_(@_)"
  ActiveWorkbook.DeleteNumberFormat NumberFormat:= _
  "_(* #,##0.0000000_);_(* (#,##0.0000000);_(* ""-""??_);_(@_)"

Exit Sub

errhandle:
  Debug.Print Err.Number & " " & Err.Description
  Resume Next
End Sub

this will continue to delete the formats even with an error, it will print errors to the debug window for your view after the fact

more work would be to do it through a list of formats you want to delete

Option Explicit
Dim lNumberformatcount As Long
Dim sNumberformats() As String
Dim sCustomNumberformats() As String

Sub RemoveUnusednumberformats()
Dim oWorkbook As Workbook
Dim oWorksheet As Worksheet
Dim sName As String
Dim rCell As Range
Dim lCounter As Long
    Set oWorkbook = ActiveWorkbook
    GetCustomFormats
    For Each oWorksheet In oWorkbook.Worksheets
        For Each rCell In oWorksheet.UsedRange
                lCounter = lCounter + 1
                ReDim Preserve sNumberformats(lCounter)
                sName = rCell.NumberFormat
                sNumberformats(lCounter) = sName
        Next
    Next
    For lCounter = lNumberformatcount To 1 Step -1
            If Application.IsNA(Application.Match(sCustomNumberformats(lCounter), sNumberformats, 0)) = True Then
                On Error Resume Next
                oWorkbook.DeleteNumberFormat (sCustomNumberformats(lCounter))
            End If
    Next
    Set oWorkbook = Nothing
    Set rCell = Nothing
End Sub
Sub GetCustomFormats()
    Dim sTemp As String
    Dim i As Integer
    ReDim sCustomNumberformats(10)
    lNumberformatcount = 1
    sCustomNumberformats(0) = " "
    ActiveWorkbook.Worksheets("Sheet2").Select
    For i = 3 To 6
        Range("A" & i).Select
        'SendKeys "{TAB}{end}{TAB}{TAB}{down}~"
        'Application.Dialogs(xlDialogFormatNumber).Show
        sTemp = ActiveCell.NumberFormat
        sCustomNumberformats(lNumberformatcount) = sTemp
        'If sCustomNumberformats(lNumberformatcount) = sCustomNumberformats(lNumberformatcount - 1) Then
        '    Exit Do
        'End If
        lNumberformatcount = lNumberformatcount + 1
        ReDim Preserve sCustomNumberformats(lNumberformatcount)
    Next
    MsgBox lNumberformatcount
    Application.DisplayAlerts = False
    'ActiveSheet.Delete
    Application.DisplayAlerts = True
End Sub

maybe you can use it, or else i woiuld just stay with the shortcut code with error handling to do it fast

Brian
0
 

Author Comment

by:meremark
ID: 7075377
Brian,

Thank you for your responses.

Tried out the error trapping method and it worked beautifully!  Very fast and simple so it met all my expectations!  And I thought the solution would be some kind of IF statement.  I never though of just trapping the errors.  Thanks.

I will play with the second option as it is more refined and I have other situations where I can use it.  I usually prefer elegant over raw unrefined solutions, and when it come to the automation I have built to produce the report, some of it is sweet.  But once the books are closed, I have three days to produce and compile my report and elegant is out the window.  I constantly need to remind myself that between two equal solutions, the simplest is always best.  Where I get twisted up in my shorts is the word “equal” as it can be very subjective.


BTW, I can see errors to the debug window when the sub is in the workbook it is being run in.  Can I use the immediate window when the sum is in my personal.xls worbook and run an another workbook? i.e. I can't start the sub from the VBA editor and have it perform an action on a different workbook can I?

Thanks,
Mark

0
 
LVL 44

Expert Comment

by:bruintje
ID: 7075436
thanks for the grade Mark

i don't get this completely

>can't start the sub from the VBA editor and have it perform an action on a different workbook can I?

you mean that you want to run this sub on a number of open workbooks?


would be something like

Sub ClearDumbFormats()

On Error GoTo errhandle

 For i to Application.Workbooks.count
  Workbooks(i).DeleteNumberFormat NumberFormat:= _
 "_(* #,##0.00000000000_);_(* (#,##0.00000000000);_    (* ""-""??_);_(@_)"
  Workbooks(i).DeleteNumberFormat NumberFormat:= _
 "_(* #,##0.0000000_);_(* (#,##0.0000000);_(* ""-""??_);_(@_)"
  next

Exit Sub

errhandle:
 Debug.Print Workbooks(i).Name & " " & Err.Number & " " & Err.Description
 Resume Next
End Sub

Brian
0
 

Author Comment

by:meremark
ID: 7075511
Brian,

Sorry for the confusion.  In your prior response you mentioned "with an error, it will print errors to the debug window for your view after the fact".  

I thought the debug window was (AKA) the immediate window and if I have the sub in my personal.xls and run it on another workbook, then switch to the VBA editor and view the immediate window I have nothing printed to the immediate window.  In this case, I do not need to view the results, but in future usage of this technique I might and was wondering how I could.  

Hopefully this is clearer.  If not, do not worry about it.

Thanks,
Mark  
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
The viewer will learn how to make their project stand out over others by learning how to change colors and shapes, add spaces, change directions, and add bullets to their charts.
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now