Custom formats/styles

[Nancy Rickard]

Is there a way to remove a large group of number formats at once from a
file?

We were infected with a virus a year ago. Since we've removed the virus
from our system we have had a large number of "No more custom number formats
can be added." errors. When I spoke with Microsoft, they indicated that
this happens as a result of the virus we were infected with (even thought
the virus is gone).

I am hoping to write a script to remove all of the custom number formats
however, I have no idea how. Also, I am curious to know if there is a
different (maybe better) way to do it.

Thank you for your help.

Nancy Rickard

[Leo Heuser]

Nancy,

For a way to do this please see my program in David Hager´s semi-monthly "Excel Experts E-letter" (EEE) issue #7, p 5. The
newsletter can be downloaded from:
http://www.j-walk.com/ss/excel/eee/index.htm

Best regards
LeoH

Nancy Rickard skrev i meddelelsen ...

[Nancy Rickard]

Thanks for the help, I'm going to test it a little later on. Will it work
in Excel 97 or is it for 2000. Is there a difference?

Leo Heuser <leo.h...@get2net.dk> wrote in message
news:#Rfv0jYN$GA.237@cppssbbsa05...

[Nancy Rickard]

I tried this and it does allow us to open the affected documents with any
errors. However, the formats are still listed if you go to the Format menu
and choose Style.

How do I remove them from this list?

Thanks for the help.

[Leo Heuser]

Nancy,

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

'24-11-1999
'leo.h...@get2net.dk November 1999
Sub DeleteUnusedStyles()
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
---------------------------------------------------------------------

Nancy Rickard skrev i meddelelsen ...

>I tried this and it does allow us to open the affected documents with any
>errors. However, the formats are still listed if you go to the Format menu
>and choose Style.
>
>How do I remove them from this list?
>
>Thanks for the help.
>
>Leo Heuser <leo.h...@get2net.dk> wrote in message
>news:#Rfv0jYN$GA.237@cppssbbsa05...
>> Nancy,
>>

>> For a way to do this please see my program in David Hager愀 semi-monthly

[Nancy Rickard]

Thanks. It worked!

Leo Heuser <leo.h...@get2net.dk> wrote in message

news:usqTgCoN$GA.253@cppssbbsa05...

> >> For a way to do this please see my program in David Hager´s