(Solved) – Loop Through a Column to Use each cell value as table title

(solved)-–-loop-through-a-column-to-use-each-cell-value-as-table-title

I am trying to make a dynamic reporting file where I can add a main category anytime and Sub Category then I can create a new sheet of each main category and add tables for each sub category on each main category sheets. I was somehow able to do until creating sheets and copy the filtered data from another sheet to the created sheets of each main category but I’m not sure how to go about using the sub categories of each main category as titles of tables then creating tables for each sub category. This is what I have so far:

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

    Sheet4.Select
    Range("X2").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

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

Leave a Reply

Your email address will not be published. Required fields are marked *