Work Distribution Macro

[Chefsohail]

Hi Team,

I am currently managing a team of people and I am facing challenges in distributing the work. Its taking time and I plan to automate this function.

I am seeking your expertise here -

Pre-requisite info
1. I have data that starts from Column A until MN. (this is for now and it may increase in future)
2. The row entries is something that I do not have control on. It can either be 200 or sky is the limit. The macro file should help me with distributing the workload evenly.
3. Eg: So my first row has headers and I have 5000 rows filled (headers are filled from Column A through MN)....(Column A will have all the 5000 cells filled.. but this may not be the case with other columns..as this involves the job and the team member is expected to fill the other columns)

Expectation from the macro.
1. This file should have a sheet where i can paste all my data.. (whether it be 1 row or 1,00,000 rows from column A - column MN and may be more in future)
2. The workbook should have a database for my list of employees and this should be expandable so that i can keep modifying the strength as the case may be. Like the table below.

3. When I execute the macro, the macro should assign tasks to only 2 people as their status is active.
4. The system should then start distributing the work and create separate files that get saved to a folder on my desktop. Folder named as - 'Allocation_ddmmyyyy'.
Eg: If I have 500 tasks to be distributed - (exclude the header row) amongst 5 team members, then i copy and paste this data from column A - column MN in the macro enabled sheet. Once i execute it, the system picks up first 100 tasks, creates a new file and copy pastes the first 100 rows from Column A through MN (or may be more in future)(Here i may have formatting eg: backgrounds / bold/ italics etc or data validation - all need to be copied). It then saves this file in folder 'Allocation_ddmmyyyy' as 'Allocation_ddmmyyyy_Employee1' and so on. So basically the folder should have 5 excel workbooks individually named as Allocation_ddmmyyyy_Employee1, Allocation_ddmmyyyy_Employee2, Allocation_ddmmyyyy_Employee3 .... and so on.

This is my first requirement.

4. If we can also add a separate macro where these file can be automatically emailed to the user.

so now the above job is done and the macro sends an email to the user that this is his work allocation for the day for now and the corresponding file should be attached on that email.
I can call these macros basis my requirement for the day.

I am pretty confident that this is doable, but I do not know how to do it. If someone can please help, that'll be great.

Please do let me know if any other information is required. I'll be glad to share.

Best Regards.

 

[Chefsohail]

I've tried it several times and I can't reproduce the problem. Are you testing the macro on the file you posted or on a different file? If on a different file, can you upload a copy of the actual file, de-sensitized if necessary? I wouldn't need all the data rows, just enough rows to test the macro. Could you answer my questions about how you want to handle the email (Post #7)? Also when replying, please click the "Reply" button instead of the "+Quote" button to avoid clutter.

Hi Mumps,

I have tried on the sample file(the one I posted) as well as by copy pasting the actuals. As much as I would love to upload the actual file, unfortunately I won't be able to. If I de-sensitize it nothing will be left.

Do you want the same macro to also automatically send the email or do you want to do that separately after the new files have been created and saved?
I do not want the same macro to send the email. I want another macro that I can call if required. That'll be after the new files have been created and saved.

What would be the subject and body of the email?
Subject: Work Allocation
Email body,:

Hi EmployeeX, (it should pickup the corresponding name)

Please find the attached work allocation.

Regards,

Chefsohail

I have always replied and never clicked on qoute.

 

[mumps]

This macro will create and display all the emails. You will have to send each one manually. If you want to send them automatically, change .Display ( in red) to .Send

Sub CreateEmail()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, rng As Range
    Set OutApp = CreateObject("Outlook.Application")
    With Sheets("Employee DB")
        .Range("B2").CurrentRegion.AutoFilter 3, "Active"
        For Each rng In .Range("B3", .Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = rng.Offset(, 1)
                .Subject = "Work Allocation"
                .HTMLBody = "Hi Employee " & rng & "," & "<br><br>" & "Please find the attached work allocation." & "<br><br><br>" _
                    & "Regards," & "<br><br>" & "Chefsohail"
                .attachments.Add Environ("userprofile") & "\Desktop\Allocation_" & Format(Date, "ddmmyyyy") & "\Allocation_" & Format(Date, "ddmmyyyy") & "_" & rng & ".xlsx"
                .Display 'change "Display" to "Send" to send the email
            End With
        Next rng
        .Range("B2").AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

I have always replied and never clicked on qoute.

BY this I meant that you don't have to paste the previous post in your response.

 

[Chefsohail]

Thanx Mumps.

 

[Chefsohail]

Try marking all the Employee's as Active within the sample data. You will see that the macro assigns only 1 task to every employee out of the 100 sample data.

I am not sure how Option Explicit works... Do i need that before the macro code?

 

[mumps]

My pleasure.

 

[Chefsohail]

I am using the same uploaded sample file and have tried multiple times Mumps.

It works intermittently and definitely doesnt work when all employees are active. I may be doing something wrong that probably i am not aware of.

I have even tried adding a 11th employee and marking him inactive.

What basically I am doing is -
1. Use the same sample file, open VBA and insert module.
2. Copy and paste the code shared by you.
3. Experimented with Option Explicit.
4. Save it as Excel macro enabled workbook.
5. Copy pasted / typed the active and inactive status in the EmployeeDB worksheet.

Will you please add the code and share the file as you did earlier. I will directly try using that file.

Do I need to select any References?

 

[mumps]

I think I have found the problem. Instead of Employee1, Employee2, Employee3, etc. in column B of Employee DB, use real names or simply put in a, b, c, d, e, etc.
The problem is with the word "AutoFill" in the code. It takes the numerical sequence in Employee1, Employee2, Employee3, etc. and continues it as Employee4 to Employee100 because there are 100 values in column B of RawData starting in row 2. So it is simply continuing the sequence creating 100 different employees instead of the number of active employees repeated as many times as needed to fill down to row 101. So changing the employee names without the numbers at the end solves the problem because there is no sequence for the macro to follow.. I hope that makes sense. Use this revised version of the macro:

Sub CreateFiles()
    Application.ScreenUpdating = False
    Dim arr As Variant, lRow As Long, i As Long, srcWB As Workbook
    Set srcWB = ThisWorkbook
    With Sheets("Employee DB")
        .Range("B2").CurrentRegion.AutoFilter 3, "Active"
        .Range("B3", .Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy .Range("F1")
        .Range("B2").AutoFilter
        arr = .Range("F1", .Range("F" & Rows.Count).End(xlUp)).Value
    End With
    With Sheets("RawData")
        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Columns("A").Insert
        Range("A1") = "Emp"
        With .Range("A2:A" & lRow)
            If .Rows.Count <= UBound(arr, 1) Then
                .Value = arr
            Else
                .Resize(UBound(arr, 1)).Value = arr
                .Resize(UBound(arr, 1)).AutoFill .Resize(.Rows.Count)
            End If
        End With
        For i = LBound(arr) To UBound(arr)
            .Range("A1").CurrentRegion.AutoFilter 1, arr(i, 1)
            .AutoFilter.Range.Copy
            Workbooks.Add
            With ActiveSheet
                .PasteSpecial
                .Columns(1).Delete
                .Name = arr(i, 1)
            End With
            With ActiveWorkbook
                .SaveAs Filename:=Environ("userprofile") & "\Desktop\Allocation_" & Format(Date, "ddmmyyyy") & "\Allocation_" & Format(Date, "ddmmyyyy") & "_" & arr(i, 1) & ".xlsx", FileFormat:=51
                .Close False
            End With
            .Range("A1").AutoFilter
        Next i
    End With
    With srcWB
        .Sheets("RawData").Columns(1).Delete
        .Sheets("Employee DB").Columns(6).ClearContents
    End With
    Application.ScreenUpdating = True
End Sub

 

[Chefsohail]

Awesome... Thanx Again

I did observe that when I stepped into the macro... However was not sure to speak abt it..

I have understood what you explained. Thanx for the clarification. I'll try the new version in sometime and will let you know.

I have added 2 codes.. 1. For creating a folder and 2. Added message box at the end of your code.
I have integrated the msgbox within yours.. However the folder creation as a different macro and have called both of them in a master macro.

I sincerely appreciate your help.
Please let me know if I can do anything to help you.

 

[Chefsohail]

Hey Mumps.

Awesome. Works flawlessly.

I wish I could learn creating macros from you...

 

[mumps]

Glad it all worked out.