View Single Post
  #12   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default re-naming styles

I had trouble running the earlier code this morning. I think that there was a
bug in it. I didn't notice it before.

But this worked ok and kept the border in my simple testing.

Option Explicit
Sub testme()
Dim myRng As Range
Dim myCell As Range
Dim WksList As Worksheet
Dim wks As Worksheet
Dim res As Variant
Dim TestStyle As Style
Dim myNewStyleName As String

Set WksList = ThisWorkbook.Worksheets("myList")

With WksList
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each wks In ActiveWorkbook.Worksheets
For Each myCell In wks.UsedRange.Cells
res = Application.Match(myCell.Style.Name, myRng, 0)
If IsError(res) Then
'not on the list, do nothing
Else
myNewStyleName = myRng(res).Offset(0, 1).Value
Set TestStyle = Nothing
On Error Resume Next
Set TestStyle = wks.Parent.Styles(myNewStyleName)
On Error GoTo 0
If TestStyle Is Nothing Then
wks.Parent.Styles.Add Name:=myNewStyleName, BasedOn:=myCell
End If
myCell.Style = myNewStyleName
End If
Next myCell
Next wks

'now clean up those old style names
On Error Resume Next
For Each myCell In myRng.Cells
ActiveWorkbook.Styles(myCell.Value).Delete
Next myCell
On Error GoTo 0

End Sub

(This is the most I've worked with styles <vbg.)

Marcel Marien wrote:

Hi Dave,

Thank you sooo much! This works wonderfully and pretty fast as well.

I have one more question. All styles in question are defined in such a way
that they ignore the frame format, that is, if they are applied to a cell,
the frame format of the cell does not change. In your re-definition based on
a cell pattern, this element of the style definition is not transported
across. Can you tell me any way how to include it?

(And by the way, your first response wasn't "dumb" at all, it set the stage
for your second response. )

Thanks a lot,
Marcel

"Dave Peterson" schrieb im Newsbeitrag
...
Yep. That's a problem that I didn't think about!

I think the only way around it is to look at every cell in the usedrange
of the
worksheet and keep track of the style that was used. Then apply the new
style
to those cells.

The good news is that it makes the code much easier. Just change the name
of
the style while the loop is running. Then after all the cells on all the
sheets
are done, delete all the old names.

Option Explicit
Sub testme()
Dim myRng As Range
Dim myCell As Range
Dim WksList As Worksheet
Dim wks As Worksheet
Dim res As Variant

Set WksList = ThisWorkbook.Worksheets("myList")

With WksList
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each wks In ActiveWorkbook.Worksheets
For Each myCell In wks.UsedRange.Cells
res = Application.Match(myCell.Style.Name, myRng, 0)
If IsError(res) Then
'not on the list, do nothing
Else
myCell.Style = myRng(res).Offset(0, 1).Value
End If
Next myCell
Next wks

'now clean up those old style names
On Error Resume Next
For Each myCell In myRng.Cells
ActiveWorkbook.Styles(myCell.Value).Delete
Next myCell
On Error GoTo 0

End Sub

I think that my other response was interesting at best, but really dumb!




--

Dave Peterson