Forum Discussion
Planted_Baker
Nov 29, 2023Copper Contributor
Generating Worksheets based on Filtered Values
My HR team is tasked with providing daily lunch box requirements to our Catering Contractor. I'm seeking to streamline this process for them.
The HR team maintains a Master Employee database worksheet named "Master" with the following columns: [name], [id], [location], [preference], and [nationality].
[location] represents the delivery location for the lunch box, denoted by 'a', 'b', 'c', etc. [preference] indicates the dietary preference, such as 'veg', 'non-veg', etc.
Certain employees on the list will not require food due to being on leave. Therefore, the HR team generates a new file each month and creates sheets based on employee availability for the month's days. Consequently, columns for each day of the month, such as [Nov1], [Nov2], [Nov3]... [Nov30], are filled with "Yes" or "No" values, indicating whether the employee will be availing food on that day.
I aim to simplify generating daily worksheets based on the data in the 'Master' worksheet. The generated worksheets should be named according to the corresponding date column, such as 'Nov1', 'Nov2', 'Nov3'... 'Nov30'.
Within each worksheet, I want to create separate tables based on the [location] values, which are 'a', 'b', and 'c'. For instance, in the worksheet 'Nov1', I want to have three tables: 'Nov1_a', 'Nov1_b', and 'Nov1_c'. Each table should include the [name], [id], [preference], and [nationality] columns for employees with a corresponding date column value of "Yes" and the matching [location] value. For example, the 'Nov1_a' table should contain the [name], [id], [preference], and [nationality] of employees with [location] = "a" and [Nov1] = "Yes". Similarly, the 'Nov1_b' table should contain the same information for employees with [location] = "b" and [Nov1] = "Yes". I want to replicate this process for all date columns in the master workbook.
While I believe VBA is the solution, my limited VBA knowledge has hindered my progress. I sought assistance from ChatGPT, which provided the following code as a solution. However, I continue to encounter errors. Any guidance in this direction would be highly appreciated.
Sub GenerateDailySheets()
Dim ws As Worksheet
Dim lr As Long
Dim lc As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim loc As Variant
Dim locs As Variant
Dim rng As Range
Dim tbl As ListObject
Dim shName As String
'Set the worksheet variable to the master sheet
Set ws = ThisWorkbook.Sheets("Master")
'Find the last row and column of the data range
lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'Create an array of the location values
locs = Array("Area 6(OC1)-Building 1-2-3", "Area 6(OC1)-Building 1-2-3", "Area 6(OC1)-Building 4", "NOT REQUIRED", "Pack Lunch", "Phubai-Phubai Building", "Area 8(UJV)-Building Subcontract", "Area 8(UJV)-Building UJV", "Area 8(UJV)-Building Commissioning", "Area 6(OC1)-Building 1-2-3(Container)")
'Loop through the date columns from column 6 to the last column
For i = 7 To lc
'Get the sheet name from the date column header
shName = ws.Cells(1, i).Value
'Create a new worksheet with the sheet name
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = shName
'Loop through the location values
'Loop through the location values
For j = 0 To UBound(locs)
'Get the current location value
loc = locs(j)
'Filter the master data by the date column and the location column
ws.Range(ws.Cells(1, 1), ws.Cells(lr, lc)).AutoFilter Field:=i, Criteria1:="Yes"
ws.Range(ws.Cells(1, 1), ws.Cells(lr, lc)).AutoFilter Field:=4, Criteria1:=loc
'Copy the filtered data to the new worksheet
ws.Range(ws.Cells(1, 1), ws.Cells(lr, 5)).SpecialCells(xlCellTypeVisible).Copy
'Activate the new worksheet
Worksheets(shName).Activate
'Paste the filtered data to the first empty column
k = Cells(1, Columns.Count).End(xlToLeft).Column + 2
Cells(1, k).PasteSpecial xlPasteAll
'Create a table from the pasted data
Set rng = Worksheets(shName).Range(Cells(l, k), Cells(IIf(IsError(WorksheetFunction.Subtotal(103, Range("A:A"))), 1, WorksheetFunction.Subtotal(103, Range("A:A"))), k + 3))
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
'Rename the table with the sheet name and the location value
tbl.Name = shName & "_" & loc
'Clear the clipboard
Application.CutCopyMode = False
Next j
'Remove the filters from the master data
ws.ShowAllData
Next i
'Close the Visual Basic Editor
ActiveWorkbook.VBProject.VBE.MainWindow.Visible = False
'Activate the master sheet
ws.Activate
'Display a message that the task is completed
MsgBox "Daily worksheets have been generated successfully.", vbInformation, "Done"
End Sub
- NikolinoDEGold Contributor
I'm not sure if this is intentional, but here's a try.