save as tables

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
375
Office Version
  1. 365
Platform
  1. Windows
i combined 2 macros that i took off the forum, both made by creative people.
it works,
however the sheets are saved as worksheets NOT tables
what do i need to amend to have the results saved as tables like the original workbook?

VBA Code:
Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer

    'This macro splits data into multiple worksheets based on the variables on a column found in Excel.
    'An InputBox asks you which columns you'd like to filter by, and it just creates these worksheets.

    Application.ScreenUpdating = False
    vcol = Application.InputBox(prompt:="Which column would you like to filter by?", title:="Filter column", Default:="3", Type:=1)
    Set ws = ActiveSheet
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
        On Error Resume Next
        If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
            ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
        End If
    Next

    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear

    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
        With Sheets(myarr(i) & "")
        .Columns.AutoFit
'        .PasteSpecial xlPasteFormats
        End With
    Next

    ws.AutoFilterMode = False
    ws.Activate
    Application.ScreenUpdating = True
    
    Call Splitbook
End Sub

Sub Splitbook()
'Updateby20140612
Dim xPath As String
xPath = "M:\all\FI Payments\Single Participant Payment Worksheets\split files 5\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
   Select Case xWs.Name
      Case "All Payments"
      Case Else
    xWs.Copy
    
    
         Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
         Application.ActiveWorkbook.Close False
   End Select
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "Complete"
End Sub
 

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

VBE313

Well-known Member
Joined
Mar 22, 2019
Messages
674
Office Version
  1. 365
Platform
  1. Windows
What do you mean by "saved as tables"? To my knowledge you cannot save a table as just a table.
 

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
375
Office Version
  1. 365
Platform
  1. Windows
right now it saves as a worksheet
i want them to be formatted as table with all table designs and benefits
is that possible?
 

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
296
Office Version
  1. 365
Platform
  1. Windows
Just echoing what VBE313 said, as far as I'm aware, Excel won't save it as a table (versus a worksheet); a table may exist on a worksheet. Based on your post#3, it sounds as though what you want is to convert the range to a table. I haven't wrapped my head around precisely what your code does, but the following code will hopefully work. Towards the end of the parse_data subroutine, try adding the following line just after the .Columns.Autofit line in your code:
.ListObjects.Add SourceType:=xlSrcRange, source:=ActiveSheet.UsedRange, xlListObjectHasHeaders:=xlYes, tablestyleName:="TableStyleMedium16"
so that it looks like this:
VBA Code:
With Sheets(myarr(i) & "")
    .Columns.AutoFit
    .ListObjects.Add SourceType:=xlSrcRange, source:=.UsedRange, xlListObjectHasHeaders:=xlYes, tablestyleName:="TableStyleMedium16"
    '.PasteSpecial xlPasteFormats
End With

You can change the tablestyleName parameter to be whichever of the table format styles you like.

Let me know if that works.
 

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
375
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

somehow when i inserted this peice of code all excel shuts down
 

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
375
Office Version
  1. 365
Platform
  1. Windows
sorry
i rewrote the code and it works like a dream
thanks

how can i further twaek the code that the saved workbooks are also filtered and divided by tabs filtered by column E
 

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
296
Office Version
  1. 365
Platform
  1. Windows
Hi. I'm not sure I understand. I suspect I already know the answer from how you've name the subroutine, but are you trying to split out each of these filtered sheets into their own workbooks? When you say you want to filter by Column E, what do you mean exactly?
 

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
375
Office Version
  1. 365
Platform
  1. Windows
thnaks
i needed firstly to create workbooks and workjsheets based on each item in column B as per filter
new workbooks need this produced sheet furthewr subdivided as tabs based on a filter on column E
 

Watch MrExcel Video

Forum statistics

Threads
1,122,207
Messages
5,594,840
Members
413,944
Latest member
3xc3ln00b

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
Top