Generating Worksheets based on Filtered Values

Copper Contributor

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

 

 

 

1 Reply

@Planted_Baker 

I'm not sure if this is intentional, but here's a try.