save as tables

[rjmdc]

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?

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

 

[VBE313]

What do you mean by "saved as tables"? To my knowledge you cannot save a table as just a table.

 

[rjmdc]

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]

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:

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]

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

 

[rjmdc]

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]

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]

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