Insert Table and slicer multiple sheets except a particular one.

GUNI

New Member
Joined
Oct 18, 2011
Messages
8
Hello all.
I have a workbook with over 20 tabs. I am trying to build a VBA code that it goes through all 19 tabs inserts rows creates a table inserts a slicer.
The tables consist of the same columns but the rows will vary. Slicer is always the same. Also, i have a Summary sheet that does not need a table.
Any direction would be helpful.

VBA Code:
Sub Macro1()


'''''''' inserts rows
    Rows("1:13").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'''''''' inserts Table

    Range("A14").Select
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$14:$N$3799"), , xlYes).Name _   '''Rows vary
        = "Table1"
'''''''' Adds slicer Always same
    Range("Table1[#All]").Select
    ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("Table1"), "Group"). _
        Slicers.Add ActiveSheet, , "Group", "Group", 366, 639.75, 144, 190
    ActiveSheet.Shapes.Range(Array("Group")).Select
'''''''' Positions slicer
    
    ActiveSheet.Shapes("Group").IncrementLeft -12  ''' Positioning in cell A1
    ActiveSheet.Shapes("Group").IncrementTop -12  ''' Positioning in cell A1
    Range("Table1[[#Headers],[Supplier]]").Select  
    
End Sub
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
VBA Code:
Sub ConvertDataToTables()

  Dim i As Integer
    Sheets(1).Select
    
    For i = 1 To Sheets.Count
        Sheets(i).Activate
    Rows("1:13").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A14").CurrentRegion.Select
        If ActiveSheet.ListObjects.Count < 1 Then
            ActiveSheet.ListObjects.Add.Name = ActiveSheet.Name
    ''''''
            ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(1), "Group"). _
            Slicers.Add ActiveSheet, , ActiveSheet.Name, "Group", 186, 450.75, 144, 198.75

    ''''
        End If
    Next i
End Sub
 
Upvote 0
Try this:

VBA Code:
Sub Macro1()
  Dim sh As Worksheet
  Dim lr As Long, n As Long
  Dim tName As String, sGroup As String

  For Each sh In Sheets
    If LCase(sh.Name) <> LCase("Summary") Then
      n = n + 1
      tName = "Table" & n
      sGroup = "Group" & n
     
      sh.Range("1:13").Insert xlDown, 0                                             ' inserts rows
      lr = sh.Range("A:N").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
      sh.ListObjects.Add(xlSrcRange, Range("A14:N" & lr), , xlYes).Name = tName     ' inserts Table
     
      ' Adds slicer Always same (Positioning in cell A1)
      ActiveWorkbook.SlicerCaches.Add(sh.ListObjects(tName), "Group").Slicers.Add _
         sh, , sGroup, "Group", sh.Range("A1").Top, sh.Range("A1").Left, 144, 190
     
    End If
  Next
End Sub
 
Upvote 1
Try this:

VBA Code:
Sub Macro1()
  Dim sh As Worksheet
  Dim lr As Long, n As Long
  Dim tName As String, sGroup As String

  For Each sh In Sheets
    If LCase(sh.Name) <> LCase("Summary") Then
      n = n + 1
      tName = "Table" & n
      sGroup = "Group" & n
   
      sh.Range("1:13").Insert xlDown, 0                                             ' inserts rows
      lr = sh.Range("A:N").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
      sh.ListObjects.Add(xlSrcRange, Range("A14:N" & lr), , xlYes).Name = tName     ' inserts Table
   
      ' Adds slicer Always same (Positioning in cell A1)
      ActiveWorkbook.SlicerCaches.Add(sh.ListObjects(tName), "Group").Slicers.Add _
         sh, , sGroup, "Group", sh.Range("A1").Top, sh.Range("A1").Left, 144, 190
   
    End If
  Next
End Sub

It doesn't work.
My code works but for every sheet.
I was trying to add "and" but it's not working.
If ActiveSheet.ListObjects.Count < 1 and ActiveSheet.name <> "summary" Then

Can if statement be nested?
If (ws.Name <> "SUMMARY") Then

1685635407500.png
 
Upvote 0
It doesn't work.
Which problem you have?
What does the error say?
On which line of the macro does it stop?

My macro works with my tests for all sheets in the workbook except the "summary" sheet if you have more sheets or the table names already exist or the slicers names already exist then it won't work.
I recommend that you try a new workbook with the sheets and the summary sheet, without tables or slicers.
 
Upvote 1
Try this:

Rich (BB code):
Sub Macro1()
  Dim sh As Worksheet
  Dim lr As Long, n As Long
  Dim tName As String, sGroup As String

  For Each sh In Sheets
    If LCase(sh.Name) <> LCase("Summary") Then
      n = n + 1
      tName = "Table_" & n
      sGroup = "Group_" & n
     
      sh.Range("1:13").Insert xlDown, 0                                             ' inserts rows
      lr = sh.Range("A:N").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
      sh.ListObjects.Add(xlSrcRange, sh.Range("A14:N" & lr), , xlYes).Name = tName     ' inserts Table
     
      ' Adds slicer Always same (Positioning in cell A1)
      ActiveWorkbook.SlicerCaches.Add(sh.ListObjects(tName), "Group").Slicers.Add _
         sh, , sGroup, "Group", sh.Range("A1").Top, sh.Range("A1").Left, 144, 190
     
    End If
  Next
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,214,957
Messages
6,122,466
Members
449,086
Latest member
kwindels

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top