Adding Tables using Excel VBA

Question

I want to add new sheets and add tables in these new sheets, using vba. As shown in the image below, there are two column Main Category and Sub Category. I want to create new sheet for every Main Category and add tables for every Sub Category based on the sheet it belongs to. Additionally I may add new entries to Main Category and Sub Category, the vba code should add sheet and tables for those as well.

So far I am able to add the new sheets , but couldn't add the tables , This is what I have:

    Sub CreateSheetsFromAList()
        Dim MyCell As Range, myRange As Range
        Dim MyCell1 As Range, myRange1 As Range
        Dim WSname As String

        Sheet1.Select
        Range("A2").Select
        Range(ActiveCell, ActiveCell.End(xlDown)).Select
        Set myRange = Selection
        Application.ScreenUpdating = False

         For Each MyCell In myRange
            If Len(MyCell.Text) > 0 Then
                'Check if sheet exists
                If Not SheetExists(MyCell.Value) Then

                    'run new reports code until before Else

                    Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
                    Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet

                    WSname = MyCell.Value 'stores newly created sheetname to a string variable

                    'filters consolidated sheet based on newly created sheetname
                    Sheet3.Select
                    Range("A:T").AutoFilter
                    Range("D1").Select
                    Range("D1").AutoFilter Field:=4, Criteria1:=WSname, Operator:=xlFilterValues

                    Range("A1:U1").Select
                    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
                    Range("A1:U" & lastRow).Select
                    Selection.Copy 'copies filtered data

                    'search and activate WSname
                    ChooseSheet WSname

                    Range("AH2").Select
                    ActiveCell.PasteSpecial xlPasteValues

                    Range("AJ:AJ").Select
                    Selection.NumberFormat = "hh:mm"
                    Range("B2").Select
                 End If
            End If

        Next MyCell

        End Sub

         Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
        Dim sht As Worksheet

         If wb Is Nothing Then Set wb = ThisWorkbook
         On Error Resume Next
         Set sht = wb.Sheets(shtName)
         On Error GoTo 0
         SheetExists = Not sht Is Nothing
         End Function

        Public Sub ChooseSheet(ByVal SheetName As String)
        Sheets(SheetName).Select
        End Sub

End result looks like this:

Here's my sample workbook without any codes: https://drive.google.com/file/d/16logfbrvoK3CVKb-j-g4167pvU_BoWYI/view?usp=sharing

You just added two pictures compared to the same question you asked before. I still do not know what the question exactly is? — Storax
– Storax, Commented Jan 3, 2020 at 14:30
I want to create new sheet for every Main Category and add tables for every Sub Category based on the sheet it belongs to. Additionally I may add new entries to Main Category and Sub Category, the vba code should add sheet and tables for those as well. I wqs able to create new sheets but couldn't add the tables. — user12481062
– user12481062, Commented Jan 3, 2020 at 14:33

Ricardo Diaz · Accepted Answer · 2020-01-03 15:47:14Z

1

This approach should get you started.

Note: There are several TODOs in the code's comments.

Steps:

1) Convert your database range to an Excel structured table called (TableDatabase).

See this article

2) Add this code behind the sheet "Database"

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    DatabaseManager.Change Target
    Application.ScreenUpdating = True

End Sub

3) Add a module and call it "DatabaseManager"

4) Add this code to the DatabaseManager module:

Option Explicit

Private Const DATABASE_TABLE_NAME As String = "TableDatabase"
Private Const DATABASE_MAINCAT_COLUMN_HEADER As String = "Main Category"
Private Const DATABASE_SUBCAT_COLUMN_HEADER As String = "Sub Category"

Private Const TABLE_OFFSET_ROWS As Long = 5
Private Const TABLE_COLUMN_LOCATION As Long = 1 ' 1 = A

Public Sub Change(ByVal Target As Range)

    Dim databaseTable As ListObject
    Dim tableRow As Long

    Set databaseTable = Range(DATABASE_TABLE_NAME).ListObject

    Select Case True
    Case Not Intersect(Target, databaseTable.ListColumns(DATABASE_MAINCAT_COLUMN_HEADER).DataBodyRange) Is Nothing
        ' TODO: Validate if adding, updating or deleting a main category

        ' Case: Add a main category sheet
        AddSheetByTitle Target.Value2, Target.Parent

        ' TODO: Case updating, deleting

    Case Not Intersect(Target, databaseTable.ListColumns(DATABASE_SUBCAT_COLUMN_HEADER).DataBodyRange) Is Nothing
        ' TODO: Validate if adding, updating  or deleting a sub category
        tableRow = Target.Row - databaseTable.HeaderRowRange.Row + 1

        ' Case: Add a subcategory table
        AddTableInSheetByName databaseTable.ListColumns(DATABASE_MAINCAT_COLUMN_HEADER).Range(tableRow), Target.Value2, Target.Parent

        ' TODO: Case updating, deleting

    Case Else

    End Select

End Sub

Public Function AddSheetByTitle(ByVal Title As String, Optional ByVal ReturnSheet As Worksheet) As Worksheet

    ' TODO: Validate if sheet name is valid

    If SheetExists(Title) = True Then Exit Function

    Dim newWorksheet As Worksheet
    Set newWorksheet = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

    ' Rename the new sheet
    newWorksheet.Name = Title

    ' Return to a previous sheet
    If Not ReturnSheet Is Nothing Then ReturnSheet.Activate

    Set AddSheetByTitle = newWorksheet

End Function

Public Function AddTableInSheetByName(ByVal TargetSheetName As String, ByVal TableName As String, Optional ByVal ReturnSheet As Worksheet) As ListObject

    Dim targetSheet As Worksheet
    Dim targetTable As ListObject
    Dim lastRow As Long

    If SheetExists(TargetSheetName) = False Then
        Set targetSheet = AddSheetByTitle(TargetSheetName)
    End If

    If TableExists(TableName) = True Then Exit Function

    Set targetSheet = ThisWorkbook.Worksheets(TargetSheetName)

    lastRow = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row

    Set targetTable = targetSheet.ListObjects.Add(SourceType:=xlSrcRange, Source:=targetSheet.Cells(lastRow, TABLE_COLUMN_LOCATION).Offset(TABLE_OFFSET_ROWS))

    targetTable.Name = TableName

    ' Set table headers and content
    targetTable.HeaderRowRange.Cells(1).Value2 = TableName

    ' Return to a previous sheet
    If Not ReturnSheet Is Nothing Then ReturnSheet.Activate


End Function

Private Function SheetExists(ByVal SheetName As String) As Boolean
    Dim evalSheet As Worksheet

    On Error Resume Next
    Set evalSheet = ThisWorkbook.Sheets(SheetName)
    On Error GoTo 0

    SheetExists = (Not evalSheet Is Nothing)
End Function

Private Function TableExists(ByVal TableName As String) As Boolean
    Dim evalTable As ListObject
    Dim evalName As String
    ' TODO: check if TableName is valid (search for invalid chars)
    evalName = Replace(TableName, " ", "_")
    On Error Resume Next
    TableExists = (Range(evalName).ListObject.Name = TableName)
    On Error GoTo 0
End Function

Note: Your end result belongs to an specific type of table. My code adds (as you initially asked) a new table to the sheet. The alternative would be to copy (duplicate) a source table and rename it.

Hope this helps. Remember to mark the answer if it does.

answered Jan 3, 2020 at 15:47

Ricardo Diaz

5,7262 gold badges24 silver badges34 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

user12481062 Over a year ago

Sorry I'm confused with ' TODO: Validate if adding, updating or deleting a main category Also nothing is showing on the macros list

Ricardo Diaz Over a year ago

TODO: You have to develop the code for those cases (if you need to). Nothing shows on the macros list because code is supposed to be executed when you add a Category and a Subcategory to the database table. You can use a breakpoint in the change event and step through it to see the logic behind

user12481062 Over a year ago

Oh okay however it didn't look like the picture with green tables I posted above

user12481062 Over a year ago

And it also has to be executed on button click

Ricardo Diaz Over a year ago

I’m sorry. StackOverflow is not a free coding service. You have to make an effort. My code gives you all the elements to obtain your result.

Collectives™ on Stack Overflow

Adding Tables using Excel VBA

1 Answer 1

5 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

5 Comments

Your Answer

Sign up or log in

Post as a guest

Related