Link to home
Start Free TrialLog in
Avatar of meremark
meremark

asked on

VBA to clear custom formats from Excel

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
Avatar of Brian Mulder
Brian Mulder
Flag of Netherlands image

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

Avatar of meremark
meremark

ASKER

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
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
ASKER CERTIFIED SOLUTION
Avatar of Brian Mulder
Brian Mulder
Flag of Netherlands image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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

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
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