Renaming styles
 

Dear group,

I want to rename styles using VBA.
I do this by creating a new style-object and copying all properties from the
old style to the new one.
Then I assign the new style to the cells and delete the old style.
Problem: It is working, but with bigger workbooks it is very slowly.
Am I thinking too complicated? The code ist listed below.

Thanks in advance, Holger.


--------------------------------------------------------------------------------------------

Private Sub RenameStyle(wb As Workbook, OldName As String, NewName As
String)
On Error Resume Next
Dim sh As Worksheet
Dim c As Range
Dim styleFrom As Style, styleTo As Style
Set styleFrom = wb.Styles(OldName)
Set styleTo = wb.Styles.Add(NewName)

' Copy style
With styleTo
.IncludeNumber = styleFrom.IncludeNumber
.IncludeFont = styleFrom.IncludeFont
.IncludeAlignment = styleFrom.IncludeAlignment
.IncludeBorder = styleFrom.IncludeBorder
.IncludePatterns = styleFrom.IncludePatterns
.IncludeProtection = styleFrom.IncludeProtection
End With
styleTo.NumberFormat = styleFrom.NumberFormat
With styleTo.Font
.Name = styleFrom.Font.Name
.Size = styleFrom.Font.Size
.Bold = styleFrom.Font.Bold
.Italic = styleFrom.Font.Italic
.Underline = styleFrom.Font.Underline
.Strikethrough = styleFrom.Font.Strikethrough
.ThemeColor = styleFrom.Font.ThemeColor
.ColorIndex = styleFrom.Font.ColorIndex
.Color = styleFrom.Font.Color
If .ThemeColor < styleFrom.Font.ThemeColor Then
.ThemeColor = styleFrom.Font.ThemeColor
End If

.TintAndShade = styleFrom.Font.TintAndShade
.ThemeFont = styleFrom.Font.ThemeFont
End With
With styleTo
.HorizontalAlignment = styleFrom.HorizontalAlignment
.VerticalAlignment = styleFrom.VerticalAlignment
.ReadingOrder = styleFrom.ReadingOrder
.WrapText = styleFrom.WrapText
.Orientation = styleFrom.Orientation
.AddIndent = styleFrom.AddIndent
.ShrinkToFit = styleFrom.ShrinkToFit
End With
With styleTo.Borders(xlLeft)
.LineStyle = styleFrom.Borders(xlLeft).LineStyle
If styleFrom.Borders(xlLeft).LineStyle < xlNone Then
.TintAndShade = styleFrom.Borders(xlLeft).TintAndShade
.Weight = styleFrom.Borders(xlLeft).Weight

.ThemeColor = styleFrom.Borders(xlLeft).ThemeColor
.ColorIndex = styleFrom.Borders(xlLeft).ColorIndex
.Color = styleFrom.Borders(xlLeft).Color
If .ColorIndex < styleFrom.Borders(xlLeft).ColorIndex Then
.ColorIndex = styleFrom.Borders(xlLeft).ColorIndex
End If
If .ThemeColor < styleFrom.Borders(xlLeft).ThemeColor Then
.ThemeColor = styleFrom.Borders(xlLeft).ThemeColor
End If
End If
End With
With styleTo.Borders(xlRight)
.LineStyle = styleFrom.Borders(xlRight).LineStyle
If styleFrom.Borders(xlRight).LineStyle < xlNone Then
.TintAndShade = styleFrom.Borders(xlRight).TintAndShade
.Weight = styleFrom.Borders(xlRight).Weight

.ThemeColor = styleFrom.Borders(xlRight).ThemeColor
.ColorIndex = styleFrom.Borders(xlRight).ColorIndex
.Color = styleFrom.Borders(xlRight).Color
If .ThemeColor < styleFrom.Borders(xlRight).ThemeColor Then
.ThemeColor = styleFrom.Borders(xlRight).ThemeColor
End If
If .ThemeColor < styleFrom.Borders(xlRight).ThemeColor Then
.ThemeColor = styleFrom.Borders(xlRight).ThemeColor
End If
End If
End With
With styleTo.Borders(xlTop)
.LineStyle = styleFrom.Borders(xlTop).LineStyle
If styleFrom.Borders(xlTop).LineStyle < xlNone Then
.TintAndShade = styleFrom.Borders(xlTop).TintAndShade
.Weight = styleFrom.Borders(xlTop).Weight

.ThemeColor = styleFrom.Borders(xlTop).ThemeColor
.ColorIndex = styleFrom.Borders(xlTop).ColorIndex
.Color = styleFrom.Borders(xlTop).Color
If .ThemeColor < styleFrom.Borders(xlTop).ThemeColor Then
.ThemeColor = styleFrom.Borders(xlTop).ThemeColor
End If
If .ThemeColor < styleFrom.Borders(xlTop).ThemeColor Then
.ThemeColor = styleFrom.Borders(xlTop).ThemeColor
End If
End If
End With
With styleTo.Borders(xlBottom)
.LineStyle = styleFrom.Borders(xlBottom).LineStyle
If styleFrom.Borders(xlBottom).LineStyle < xlNone Then
.TintAndShade = styleFrom.Borders(xlBottom).TintAndShade
.Weight = styleFrom.Borders(xlBottom).Weight

.ThemeColor = styleFrom.Borders(xlBottom).ThemeColor
.ColorIndex = styleFrom.Borders(xlBottom).ColorIndex
.Color = styleFrom.Borders(xlBottom).Color
If .ThemeColor < styleFrom.Borders(xlBottom).ThemeColor Then
.ThemeColor = styleFrom.Borders(xlBottom).ThemeColor
End If
If .ThemeColor < styleFrom.Borders(xlBottom).ThemeColor Then
.ThemeColor = styleFrom.Borders(xlBottom).ThemeColor
End If
End If
End With
With styleTo.Borders(xlDiagonalDown)
.LineStyle = styleFrom.Borders(xlDiagonalDown).LineStyle
If styleFrom.Borders(xlDiagonalDown).LineStyle < xlNone Then
.TintAndShade = styleFrom.Borders(xlDiagonalDown).TintAndShade
.Weight = styleFrom.Borders(xlDiagonalDown).Weight

.ThemeColor = styleFrom.Borders(xlDiagonalDown).ThemeColor
.ColorIndex = styleFrom.Borders(xlDiagonalDown).ColorIndex
.Color = styleFrom.Borders(xlDiagonalDown).Color
If .ThemeColor < styleFrom.Borders(xlDiagonalDown).ThemeColor
Then
.ThemeColor = styleFrom.Borders(xlDiagonalDown).ThemeColor
End If
If .ThemeColor < styleFrom.Borders(xlDiagonalDown).ThemeColor
Then
.ThemeColor = styleFrom.Borders(xlDiagonalDown).ThemeColor
End If
End If
End With
With styleTo.Borders(xlDiagonalUp)
.LineStyle = styleFrom.Borders(xlDiagonalUp).LineStyle
If styleFrom.Borders(xlDiagonalUp).LineStyle < xlNone Then
.TintAndShade = styleFrom.Borders(xlDiagonalUp).TintAndShade
.Weight = styleFrom.Borders(xlDiagonalUp).Weight

.ThemeColor = styleFrom.Borders(xlDiagonalUp).ThemeColor
.ColorIndex = styleFrom.Borders(xlDiagonalUp).ColorIndex
.Color = styleFrom.Borders(xlDiagonalUp).Color
If .ThemeColor < styleFrom.Borders(xlDiagonalUp).ThemeColor
Then
.ThemeColor = styleFrom.Borders(xlDiagonalUp).ThemeColor
End If
If .ThemeColor < styleFrom.Borders(xlDiagonalUp).ThemeColor
Then
.ThemeColor = styleFrom.Borders(xlDiagonalUp).ThemeColor
End If
End If
End With
With styleTo.Interior
.Pattern = styleFrom.Interior.Pattern

.PatternThemeColor = styleFrom.Interior.PatternThemeColor
.PatternColorIndex = styleFrom.Interior.PatternColorIndex
.PatternColor = styleFrom.Interior.PatternColor
If .PatternThemeColor < styleFrom.Interior.PatternThemeColor Then
.PatternThemeColor = styleFrom.Interior.PatternThemeColor
End If

.ThemeColor = styleFrom.Interior.ThemeColor
.ColorIndex = styleFrom.Interior.ColorIndex
.Color = styleFrom.Interior.Color
If .ThemeColor < styleFrom.Interior.ThemeColor Then
.ThemeColor = styleFrom.Interior.ThemeColor
End If

.TintAndShade = styleFrom.Interior.TintAndShade
.PatternTintAndShade = styleFrom.Interior.PatternTintAndShade
End With
With styleTo
.Locked = styleFrom.Locked
.FormulaHidden = styleFrom.FormulaHidden
End With

' Assign new style to cells
For Each sh In wb.Sheets
For Each c In sh.UsedRange.Cells
If c.Style.Name = styleFrom.Name Then
c.Style = styleTo.Name
End If
Next c
Next sh

' Delete old style
styleFrom.Delete

End Sub