jazz2409
01-06-2020, 02:12 AM
I am creating a reporting file where 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.
25751
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
The result should look like this
25752
What is the best approach in getting the above result? Please help
25751
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
The result should look like this
25752
What is the best approach in getting the above result? Please help