2

enter image description here

I have sheet named "raw" and I want to filter it using button function. in "raw" sheet, there this table which have random header. what I want to do is that when I click the button, then new sheet "filter" will be generate with table where the header is more organized.

I am able to create new sheet within button but generating organized table is harder. I want to ask is it possible to create this table? I am a VBA Learner and interest in learn more in VBA programming.

By the way, I have try to make table using

Dim Ws As Worksheet
Set Ws = ThisWorkbook.Sheets("Sheet_Name")

Ws.ListObjects.Add(xlSrcRange, Ws.Range("A$xx:$V$xx"), , xlYes).Name = "New_Table_Name"
Ws.ListObjects("New_Table_Name").TableStyle = "TableStyleLight1"

and still I cannot naming the column table header.

Mohamad Faisal
  • 81
  • 1
  • 11
  • Please specify language you're using in tags – Vadim Kotov Mar 19 '18 at 10:19
  • Hi there. A number of folks in our community sometimes say that every time they see gendered assumptions about software engineers, they worry about people feeling excluded. I wonder, could you try to avoid adding male-oriented greetings and pronouns in your posts, so as to make for a more welcoming environment? Thank you. – halfer Mar 19 '18 at 17:11
  • Sure I will. I meant no offense towards other gender. I am sorry. Thanks for the information. – Mohamad Faisal Mar 20 '18 at 06:29

2 Answers2

1

Create a new Standard VBA module and paste the code bellow

If Worksheets("Filter") already exists:


Option Explicit

Public Sub CopyTable()      'Worksheets("Filter") exists

    Const TBL_ID = "New_Table_Name"
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = ThisWorkbook.Worksheets("Raw")
    Set ws2 = ThisWorkbook.Worksheets("Filter")

    Application.ScreenUpdating = False
    ws1.ListObjects(1).Range.Copy
    With ws2
        .Cells(1).PasteSpecial Paste:=xlPasteAll
        .Cells(1).PasteSpecial Paste:=xlPasteColumnWidths
        .Cells(1).Select
        .ListObjects(1).Name = TBL_ID
        MoveTableCols ws2, TBL_ID       'calls 3rd Sub **************
    End With
    Application.ScreenUpdating = True
End Sub

This will create a new Worksheet called "Filter"


Public Sub CopyWs()         'Creates a new Worksheets("Filter")

    Const TBL_ID = "New_Table_Name"
    Dim ws1 As Worksheet, ws2 As Worksheet, wsCount As Long

    Application.ScreenUpdating = False
    With ThisWorkbook
        Set ws1 = .Worksheets("Raw")
        ws1.Copy After:=.Worksheets(.Worksheets.Count)
        wsCount = .Worksheets.Count
        Set ws2 = .Worksheets(wsCount)
    End With
    ws2.Name = "Filter"
    ws2.ListObjects(1).Name = TBL_ID
    MoveTableCols ws2, TBL_ID           'calls 3rd Sub **************
    Application.ScreenUpdating = True
End Sub

The Sub bellow is called by both Subs above, and reorganizes the new table


'Called by CopyTable() and CopyWs() Subs

Private Sub MoveTableCols(ByRef ws As Worksheet, ByVal tblId As String)

    Dim arr As Variant

    With ws
        .Rows(4).Delete Shift:=xlUp 'To delete rows based on criteria use Autofilter

        .ListObjects(tblId).ListColumns.Add Position:=6

        arr = .ListObjects(tblId).ListColumns(1).DataBodyRange
        .ListObjects(tblId).ListColumns(6).DataBodyRange = arr

        arr = .Cells(1)
        .Columns(1).Delete Shift:=xlToLeft
        .Cells(5) = arr
    End With
End Sub

As Vityata mentioned, the Macro Recorder will generate the code for all your manual actions, you'll just need to improve it be removing all Activate and Select statements

Note: A table cannot have 2 identical headers so moving a column involves creating a new column, copying the data from the initial column, then "remembering" the header name, deleting the initial column, and renaming the header for the new column to the initial header name

paul bica
  • 10,557
  • 4
  • 23
  • 42
  • I'm glad it helped! Please make sure to accept the answer that worked for you: to mark an answer as accepted, click on the check mark beside the answer to toggle it from greyed out to green - [more details Here](https://stackoverflow.com/help/someone-answers) – paul bica Mar 21 '18 at 07:35
0

As far as you are studying VBA for 3 days, it is a really good idea to start using the Macro recorder for tasks like this, at least to have a starting point. This is a simple example from the Macro Recorder:

Sub Makro1()
'
' Makro1 Makro
'

'
    Cells.Clear
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E$13"), , xlNo).Name = _
        "Table1"
    Range("Table1[#All]").Select
    ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight9"
    Range("Table1[[#Headers],[Column1]]").Select
    ActiveCell.FormulaR1C1 = "Header1"
    Range("Table1[[#Headers],[Column2]]").Select
    ActiveCell.FormulaR1C1 = "Second Header"
    Range("Table1[[#Headers],[Column3]]").Select
    ActiveCell.FormulaR1C1 = "Third Header"
    Range("Table1[[#Headers],[Column4]]").Select
    ActiveCell.FormulaR1C1 = "Forth Header"
    Range("Table1[[#Headers],[Column5]]").Select
    ActiveCell.FormulaR1C1 = "Fifth Header"
    Range("A2").Select
End Sub

Play a bit, see how it works, use F8. After some time, you can look for a way to avoid the .Select and ActiveSheet. This is some example that can be automized further with a loop, based on the number of the header rows. However, it does not use ActiveSheet and Select:

Option Explicit

Sub TestMe()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    Dim tbl As ListObject

    With ws
        .Cells.Clear
        .ListObjects.Add(xlSrcRange, .Range("A1:E10"), , xlNo).Name = "MyFirstTable"
        Set tbl = .ListObjects(1)

        tbl.HeaderRowRange.Cells(1, 1) = "SomeHeader1"
        tbl.HeaderRowRange.Cells(1, 2) = "SomeHeader2"
        tbl.HeaderRowRange.Cells(1, 3) = "SomeHeader3"
        tbl.HeaderRowRange.Cells(1, 4) = "SomeHeader4"
        tbl.HeaderRowRange.Cells(1, 5) = "SomeHeader5"            
    End With

End Sub

E.g., if you want to loop through the header and hive some values, then this is the content of the With ws:

With ws
    .Cells.Clear
    .ListObjects.Add(xlSrcRange, .Range("A1:E10"), , xlNo).Name = "MyFirstTable"
    Set tbl = .ListObjects(1)

    Dim myCell  As Range        
    For Each myCell In tbl.HeaderRowRange.Cells
        myCell = "SomeHeader " & myCell.Column
    Next myCell
End With
Vityata
  • 42,633
  • 8
  • 55
  • 100
  • 1
    I have try macro recording and recording it. then I look into it and start confuse with the .select . is there anyway to simplified the recording code? – Mohamad Faisal Mar 21 '18 at 07:28
  • 1
    @MohamadFaisal - yup. It is called "refactoring". You take the code and you start removing `.Select` and `.ActiveCell` anywhere you see it. Take a look here for some ideas - https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – Vityata Mar 21 '18 at 09:20