Need a procedure to clear styles.

[rongr75]

Hey,

Need some serious help. We have some Excel models that have been carried around for a while now and every time a component is copied from workbook to workbook all the styles are incorporated with the new workbook and this is compiling and getting to the point where we cannot format cells.

The issue is, Under Format, Styles, Style Name... I need to clear these without manually doing it one by one. I know a macro in VB can be created but need assistance. Please advise!

Thank you so much!!!

[Anne Troy]

As a background, we've been working with rongr75 over here:

http://www.theofficeexperts.com/forum/showthread.php?t=4118

[Norie]

There is a Styles collection of the workbook object.

Perhaps you could use that to delete any unwanted styles.

[rongr75]

Thanks Dreamboat,

Thought you went home. and I saw the VB that kplus posted, figured give a try here too. Again, appreciate the efforts. KPLUS was so close.

[Anne Troy]

Went home? I never left! :)

(I work from home.)

[rongr75]

Norie,

Apparently I am very lost here. Teh only way I can fathom this is through the macro VB that I was workign with Dreamboat and KPLUS on. How do you delete unwanted styles in Excel besides manually one by one. I have close to a thousand styles or more, in hundreds and hundreds of workbooks. This is why I need some help here!

<<Losing hair as I type! LOL>>

UGH!

You are a god! Work from home and have my answer??? Who must I sacrifice?

[Anne Troy]

Okay. I'll quit working on the PAYING project to help you. LOL!!
Give me a few minutes...

Okay. I did a search, and lo and behold, I ended up back here!!

http://www.vbaexpress.com/forum/showthread.php?t=284

Then, Colo's post in that thread took me here:

http://support.microsoft.com/default.aspx?scid=kb;EN-US;247980

So, here's the code.
Hit Alt+F11 to open the visual basic editor (VBE).
I suggest you store this procedure in your personal.xls file (click it on the left). Hit Insert-Module. Paste this code into the window that appears at right.
Hit your SAVE diskette and close the VBE.
Make yourself a toolbar button--make sure it's in your personal.xls too.


Sub RebuildDefaultStyles()
'The purpose of this macro is to remove all styles in the active
'workbook and rebuild the default styles. "Normal" cannot be
'deleted. Therefore the macro does not attempt to delete it.
'It rebuilds the default styles by merging them from a new workbook.
'Dimension variables.
Dim MyBook As Workbook
Dim tempBook As Workbook
Dim CurStyle As Style
'Set MyBook to the active workbook.
Set MyBook = ActiveWorkbook
'Delete all the styles in the workbook.
For Each CurStyle In ActiveWorkbook.Styles
If CurStyle.Name <> "Normal" Then CurStyle.Delete
Next CurStyle
'Open a new workbook.
Set tempBook = Workbooks.Add
'Disable alerts so you may merge changes to the Normal style
'from the new workbook.
Application.DisplayAlerts = False
'Merge styles from the new workbook into the existing workbook.
MyBook.Styles.Merge Workbook:=tempBook
'Enable alerts.
Application.DisplayAlerts = True
'Close the new workbook.
tempBook.Close
End Sub

[rongr75]

Man Dreamboat,

If you were in NYC, I would buy you a case of beer!

I think we almost there. I ran the macro and got a debug error on this line:


If CurStyle.Name <> "Normal" Then CurStyle.Delete

Bold represents highlighted error

[Anne Troy]

And what version are we using?

I had no problem/error running it in 2003 or in 97. Hmmm....

And be careful. I'm only about 2 hours away. :D

[rongr75]

VB6.3

[Anne Troy]

What? oh. Ok. LOL

That would be Excel 2003, I guess. How many times have you tried running it? Can you run it again? I didn't get an error....

Do you have any OTHER code in your workbooks?

I ask because troubleshooting a workbook can include copying all the sheets to a new workbook. But you gotta export your code and such, too...just wondering...

[rongr75]

Yes, everytime i run it it gets the error at that point.

Is there a possible way that i could send you a sheet of the file and you can try to debug?

No there is no other code.

[Anne Troy]

Yep.
Anne@
(this website)

[rongr75]

I sent it. I just copied a cover page into a new workbook and if you format, styles, style name, you shall see my horror!

it came from rgranite@

[Anne Troy]

ko.

:)

[Anne Troy]

No i

I deleted your post. We don't want bots picking up @vbaexp email addies. :)

I don't know, Ron. I've reported the error on their KB article to MS. I'm still looking, tho.

[rongr75]

I appreciate it. Damn i knew this was a horrible way to start a weekend! and my vacation! LOL

[Anne Troy]

No worries. I'm cross-posting: http://www.experts-exchange.com/Applications/MS_Office/Excel/Q_21356767.html

[rongr75]

Sorry, if I am being a pain. It just that my vacation starts tonight, and I would like this project completed.

and want to keep my hair cause i like it how it is! LOL

Keep me updated.

[johnske]

Hi rongr,

If I'm reading this correctly, you can use this. I'll put the code below and an attached workbook.

Extract the workbook "StyleChange" to a folder, move all the workbooks that need all these extra styles deleted to the same folder. Now open 'StyleChange' and click the button 'Delete extra styles' and all the workbooks in the folder will have this applied to them...

Option Explicit
Sub ChangeStyle()
Dim N&, Style As Style
Application.ScreenUpdating = False
With Application.FileSearch
.LookIn = ActiveWorkbook.Path
.Filename = "*.xls"
If .Execute > 0 Then
For N = 1 To .FoundFiles.Count
If .FoundFiles(N) <> ThisWorkbook.FullName Then
Application.Workbooks.Open(.FoundFiles(N)).Activate
For Each Style In ActiveWorkbook.Styles
If Style.Name <> "Normal" Then Style.Delete
Next Style
ActiveWorkbook.Close savechanges:=True
End If
Next N
End If
End With
End Sub

HTH
John

PS this doesn't give errors on Office 2000

[Anne Troy]

Sorry, John.

This has progressed a wee bit. The problem is that the style names have become corrupt.

I did try your workbook, tho. It did nothing in 2003 (but no error) and threw the same error in 2000.

See: http://www.experts-exchange.com/Applications/MS_Office/Excel/Q_21356767.html

It's only marked Solved at EE 'cause I believe the issue is with the corrupt styles, not the code.

[johnske]

Sorry, John.

This has progressed a wee bit. The problem is that the style names have become corrupt.

I did try your workbook, tho. It did nothing in 2003 (but no error) and threw the same error in 2000.

See: http://www.experts-exchange.com/Applications/MS_Office/Excel/Q_21356767.html

It's only marked Solved at EE 'cause I believe the issue is with the corrupt styles, not the code.


Hi Anne,

The problem that I see is that "Normal" in any particular workbook is user-defined, the style name "Normal" is an Office default, but that doesn't mean the settings for the book are Office default - they're always user defined.

Bexause of the many different styles used in all these books (opened on the same application) perhaps "Normal" itself has been corrupted and needs to be re-defined, something like this maybe?Option Explicit
Sub ChangeStyle()
Dim N&, Style As Style
Application.ScreenUpdating = False
With Application.FileSearch
.LookIn = ActiveWorkbook.Path
.Filename = "*.xls"
If .Execute > 0 Then
For N = 1 To .FoundFiles.Count
If .FoundFiles(N) <> ThisWorkbook.FullName Then
Application.Workbooks.Open(.FoundFiles(N)).Activate

'//Define your own "Normal" style here
'*******************************
With ActiveWorkbook.Styles("Normal")
.IncludeNumber = True
.IncludeFont = True
.IncludeAlignment = True
.IncludeBorder = True
.IncludePatterns = True
.IncludeProtection = True
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.ReadingOrder = xlContext
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.NumberFormat = "General"
.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Interior.Pattern = xlNone
.Locked = True
.FormulaHidden = False
End With
With ActiveWorkbook.Styles("Normal").Font
.Name = "Arial"
.Size = 10
.Bold = False
.Italic = False
.Underline = xlUnderlineStyleNone
.Strikethrough = False
.ColorIndex = xlAutomatic
End With
Selection.Style = "Normal"
'***********************************

ActiveWorkbook.Close savechanges:=True
End If
Next N
End If
End With
End Sub

[Anne Troy]

Nope. The whole problem lies in that some of the style names aren't recognizable by the code. There's no problem with normal. We just want to unload hundreds of styles stored in the files.

[johnske]

Hi Ron,

Just had a look at the workbook you emailed me. The problem is that the names of some of the "styles" aren't styles at all, their names are actually number formats and so on and this is causing the error. i.e. they're not proper names for a style...

Added to this, there are almost 3000 of these "styles". The procedure below will delete all but about 12 of them.

Of the remainder, some can be deleted 'by hand' and some can't. I don't know exactly what has been put in as "styles" {e.g. one of these remaining "styles" is =C:\\WINNT\SYSTEM35\COMMAND. (something)}. I'll leave these for someone else to look at...

This procedure is slow (it takes about one minute to do the test book you sent) but it will clean it up quite a bit and I'm sure someone else will improve on it.Option Explicit
Sub DoThis()
Dim i&
Application.ScreenUpdating = False
Sheets.Add before:=Sheets(1)
For i = 1 To ActiveWorkbook.Styles.Count
[A65536].End(xlUp).Offset(1, 0) = ActiveWorkbook.Styles(i).Name
Next
[A2].Select
Do
If Selection.Text Like "Normal" Then
Selection.Offset(1, 0).Select
Else
On Error Resume Next '< it's number format
ActiveWorkbook.Styles(Selection.Text).Delete
On Error Resume Next '< it's text
ActiveWorkbook.Styles(Selection.NumberFormat).Delete
Selection.ClearContents
Selection.Offset(1, 0).Select
End If
Loop Until Selection.Text = Empty
Application.DisplayAlerts = False
ActiveSheet.Delete
End Sub

Regards,
John

[Ken Puls]

Hi guys,

Ron, I just wanted to apologize for not getting back to you at the TOE thread you started. I had registered for the first time there to provide you with the code I posted, and did't realize that the defaults there were NOT to email you with posting notifications.

It looks like you're in good hands now though, but if I can be of any help to you, please don't hesitate to let me know and I'll do what I can.

John, quick Q for you... do you need the 2nd On Error Resume Next in the Else block? No Goto 0 either. Just curious if it's intentional or a typo? :dunno

[johnske]

Hi Ken,

The second On Errors's still in the larger loop and I wanted to make sure I completely cleared the error with the "Resume" before it loops back on itself.

I suppose Goto 0 may have also done the trick, but I just wanted A solution... It's not elegant (e.g. it would go much faster if all the "Selects" were eradicated) but it's a start-point.

Regards,
John

Ron: This's a bit better version of the code above, it cuts the time down to almost half of the previous:Sub ClearStyles()
Dim i&, Cell As Range, RangeOfStyles As Range
Application.ScreenUpdating = False
'Add a temporary sheet
Sheets.Add before:=Sheets(1)
'List all the styles
For i = 1 To ActiveWorkbook.Styles.Count
[a65536].End(xlUp).Offset(1, 0) = ActiveWorkbook.Styles(i).Name
Next
Set RangeOfStyles = Range(Columns(1).Rows(2), Columns(1).Rows(65536).End(xlUp))
For Each Cell In RangeOfStyles
If Cell.Text Like "Normal" Then
Cell.Offset(1, 0).Select
Else
On Error Resume Next
ActiveWorkbook.Styles(Cell.Text).Delete
ActiveWorkbook.Styles(Cell.NumberFormat).Delete
End If
Next Cell
'delete the temp sheet
Application.DisplayAlerts = False
ActiveSheet.Delete
End Sub

[rongr75]

JOHHHNNNNN!!!!

you are awesome man!!! I SOOOO Appreciate you and Dreamboat. And thanks KPULS TOO!

This worked! OH MY LORD! LOL

Yes JOHN final request, if you could do it with a loop. Also, those corrupt styles shouldn't matter, but if anyone does come up with anything, let me know.

rongr75
-- wish i could buy you all a beer!

[Anne Troy]

-- wish i could buy you all a beer!

You can, Ron!!
Just make a small donation at the PayPal link...
Hee hee.
We take ANY size donation!
:)

[johnske]

Hi Ron,

Glad to see you like it.:thumb

Here's the procedure in a loop... put it in a workbook with all the books whose styles you want to clear and it'll clear all the workbooks in the folder but - because of the sheer number (~3000) of styles in each book, it may take around a minute a book (depends on your computer) so, if you have a REAL LOT of books like this you better run it when you don't need the computer (say overnight). Here's the code for the loop....

(I've also put it into an attachment here that you can download and use)Option Explicit
'<< CLEAR THE STYLES FROM ALL BOOKS IN THIS FOLDER >>
Sub ClearStyles()
Dim i&, N&, Cell As Range, RangeOfStyles As Range
Application.ScreenUpdating = False
With Application.FileSearch
.LookIn = ActiveWorkbook.Path
.Filename = "*.xls"
If .Execute > 0 Then
For N = 1 To .FoundFiles.Count
If .FoundFiles(N) <> ThisWorkbook.FullName Then
Application.Workbooks.Open(.FoundFiles(N)).Activate
'Clear Styles
'********************************************
'Add a temporary sheet
Sheets.Add before:=Sheets(1)
'List all the styles
For i = 1 To ActiveWorkbook.Styles.Count
[a65536].End(xlUp).Offset(1, 0) = ActiveWorkbook. _
Styles(i).Name
Next
Set RangeOfStyles = Range(Columns(1).Rows(2), _
Columns(1).Rows(65536).End(xlUp))
For Each Cell In RangeOfStyles
If Cell.Text Like "Normal" Then
Cell.Offset(1, 0).Select
Else
On Error Resume Next
ActiveWorkbook.Styles(Cell.Text).Delete
ActiveWorkbook.Styles(Cell.NumberFormat).Delete
End If
Next Cell
'********************************************

'delete the temp sheet
Application.DisplayAlerts = False
ActiveSheet.Delete
ActiveWorkbook.Close savechanges:=True
End If
Next N
End If
End With
End Sub

Regards,
John :devil:


PS so you can marked this solved?

[Anne Troy]

John: Thanks a bunch. You're so giving of your time...

[johnske]

Not a prob....(I enjoy the challenge)

[Ken Puls]

John!

Why hasn't the KB Bot said anything about this entry yet? ;)

[johnske]

John!

Why hasn't the KB Bot said anything about this entry yet? ;)

Give us a hour or two! :whip I only just woke up...:devil: