PDA

View Full Version : loop an excel table to update styles



Jan Martens
11-09-2017, 06:41 AM
Hi all ,
the excel table has 2 columns. The first stores names for the styles. The second stores accordingly the basedon format.
The loop executes basicly

ActiveWorkbook.Styles.Add Name:="sexy", basedon:=activecell

I keep getting different errors when trying to arrange.
This code has Err :compilation error Object required in Set strnewstyle = CStr(stylenamerange(index))



Thanks to all helping me out.

This is the code.


Sub createstyles()

Dim stylenamerange As Range
Dim basedonrange As Range
Dim index As Long
Dim strnewstyle As String

Set stylenamerange = Sheet1.ListObjects("tbl_Styletable").DataBodyRange.Columns(1)
Set basedonrange = Sheet1.ListObjects("tbl_Styletable").DataBodyRange.Columns(2)
index = 1

For index = 1 To stylenamerange.Rows
Set strnewstyle = CStr(stylenamerange(index))
ActiveWorkbook.Styles.Add Name:=strnewstyle, basedon:=basedonrange(index)
Next
End Sub

snb
11-09-2017, 06:47 AM
Dat lijkt me ook een totaal overbodige VBA regel.

Paul_Hossler
11-09-2017, 06:55 AM
Only looking at the line in error ....


Set strnewstyle = CStr(stylenamerange(index))


... strnewstyle is Dim-ed as a String, so you don't use Set


You probably just want ...


strnewstyle = stylenamerange(index)

Jan Martens
11-09-2017, 07:36 AM
Thanks Paul, I ve done this .Now
For index = 1 To stylenamerange.Rows has Err 13 type incompability.

Jan Martens
11-09-2017, 07:37 AM
Dank je wel.

Maar overbodig? Heb ik niet begrepen.

Paul_Hossler
11-09-2017, 07:53 AM
Thanks Paul, I ve done this .Now
For index = 1 To stylenamerange.Rows has Err 13 type incompability.




For index = 1 To stylenamerange.Rows.Count

snb
11-09-2017, 08:02 AM
Bijna alles is overbodig

Sub M_snb()
sn = Sheet1.ListObjects("tbl_Styletable").DataBodyRange

For j= 1 To ubound(sn)
ActiveWorkbook.Styles.Add sn(j,1), sn(j,2)
Next
End Sub


Kijk ook eens bij: http://www.snb-vba.eu/VBA_Arrays.html

Jan Martens
11-09-2017, 08:25 AM
Hartelijk bedankt voor je interesse , er is een Add method from the styles class error. Ik denk dat het eerste argument om tekst vraagt.

snb
11-09-2017, 09:11 AM
Ik kan niet zien wat er (niet) in je tabel staat.

Het 2e argument schijnt sowieso weggelaten te moeten worden.

Dan houden we dit nog over:


Sub M_snb()
sn = Sheet1.ListObjects("tbl_Styletable").DataBodyRange

For j= 1 To ubound(sn)
if sn(j,1)<>"" then ActiveWorkbook.Styles.Add sn(j,1)
Next
End Sub

Jan Karel Pieterse
11-09-2017, 09:55 AM
snb: het tweede argument is een range object...

Jan Martens
11-09-2017, 10:08 AM
Hi , dit doet het. In de tweede kolom staan geformateerde cellen.


Sub createstyles()
Dim loopsheet As Worksheet
Dim arrstylestbl()
Dim j As Long
Set loopsheet = Feuil1
arrstylestbl = loopsheet.ListObjects("tbl_Styletable").DataBodyRange
For j = 1 To UBound(arrstylestbl)
ActiveWorkbook.Styles.Add Name:=arrstylestbl(j, 1), basedon:=loopsheet.ListObjects("tbl_Styletable").DataBodyRange(j, 2)
Next
End Sub

snb
11-09-2017, 10:43 AM
En ce cas suffit:


Sub M_snb()
For each it in Feuil1.ListObjects("tbl_Styletable").DataBodyRange.columns(1)
ActiveWorkbook.Styles.Add it.value, it.offset(,1)
Next
End Sub


@JKP
In the helpfiles (E 2010) no second argument of styles.Add was mentioned, nor described.
In Intellisense it's only indicated as optional.

Jan Martens
11-09-2017, 10:49 AM
Hi, this my final code. Thanks to all.


Sub createstyles()

Dim arrstylestbl()
Dim j As Long
Dim looprange As Range
Set looprange = Feuil1.ListObjects("tbl_Styletable").DataBodyRange
arrstylestbl = looprange
For j = 1 To UBound(arrstylestbl)
ActiveWorkbook.Styles.Add Name:=arrstylestbl(j, 1), basedon:=looprange(j, 2)
Next

Jan Martens
11-09-2017, 10:58 AM
Er zijn problemen in
ActiveWorkbook.Styles.Add it.Value, it.Offset(, 1), ERR 13 type

Dit werkt nu voor me


Sub createstyles()
Dim arrstylestbl()
Dim j As Long
Dim looprange As Range
Set looprange = Feuil1.ListObjects("tbl_Styletable").DataBodyRange
arrstylestbl = looprange
For j = 1 To UBound(arrstylestbl)
ActiveWorkbook.Styles.Add Name:=arrstylestbl(j, 1), basedon:=looprange(j, 2)
Next
End Sub

Jan Martens
01-21-2018, 03:56 PM
All is explained in the code comments


Sub managestyles()


' manage styles from a table "tbl_Styletable" in sheet1.


'"tbl_Styletable" has 3 columns with headers.
' 1° column entitled: stylename.
' What you write in this column will be the stylename you'll see in the cell styles tab.
' 2° column entitled: startstyle.
' This column contains the format you SEE in the cell styles tab. Any text writen here will be ignored in the cell styles tab.
' 3° column entitled: changedstyle.
' This column contains the format you WILL SEE in the cell styles tab after running managestyles(). Any text writen here will be ignored in the cell styles tab.


' The format of the third column is the format picked up by the routine.


'The very first time you run the routine: format the second and the third column absolutely identical.Run managestyles().
'The next time you have the second column containing the existing formats and you use the third column for the changed formats. Run managestyles().
'From the third time on. To make new changes: run preparechange(). This routine copies the third column on the second.
'So you have the second column containing the existing formats and you use the third column for the changed formats.Run managestyles().
'to move a style from the table , remove the whole table row.


clearunneededstyles
updatestyles


End Sub
Sub clearunneededstyles()


'Clears all styles in the cell styles tab (except "Normal") that are not in the first column of the table


Dim style As Variant


Dim looprange As Range
Set looprange = Feuil1.ListObjects("tbl_Styletable").DataBodyRange.Columns(1)


Dim arrstylenames()
arrstylenames() = looprange


For Each style In ActiveWorkbook.Styles

If Not style Like "Normal" And IsError(Application.Match(style, arrstylenames, 0)) Then
style.Delete

End If

Next style

End Sub


Sub updatestyles()


' Loads all styles from the table in the cell styles tab. Updates styles already used on the worksheet.


Dim arrstylestbl()
Dim j As Long


Dim wkrange As Range
Set wkrange = Feuil1.ListObjects("tbl_Styletable").DataBodyRange
arrstylestbl = wkrange


For j = 1 To UBound(arrstylestbl)
ActiveWorkbook.Styles.Add Name:=arrstylestbl(j, 1), basedon:=wkrange(j, 3)
Next


End Sub




Sub preparechange()


' copies the third column on the second . I run this before making new changes, so i have the existing styles in the second column as a reference
' and i use the third column to make changes.


Feuil1.ListObjects("tbl_Styletable").DataBodyRange.Columns(3).Copy Destination:=Feuil1.ListObjects("tbl_Styletable").DataBodyRange.Columns(2)




End Sub




Er zijn problemen in
ActiveWorkbook.Styles.Add it.Value, it.Offset(, 1), ERR 13 type

Dit werkt nu voor me


Sub createstyles()
Dim arrstylestbl()
Dim j As Long
Dim looprange As Range
Set looprange = Feuil1.ListObjects("tbl_Styletable").DataBodyRange
arrstylestbl = looprange
For j = 1 To UBound(arrstylestbl)
ActiveWorkbook.Styles.Add Name:=arrstylestbl(j, 1), basedon:=looprange(j, 2)
Next
End Sub

snb
01-21-2018, 04:03 PM
I fear you change your worksheet too often.

Upload a sample workbook.

Jan Martens
01-22-2018, 08:24 AM
I fear you change your worksheet too often.

Upload a sample workbook.


Uploaded

Jan Martens
01-23-2018, 10:17 AM
Uploaded