Work Distribution Macro

Chefsohail

Board Regular
Joined
Oct 3, 2020
Messages
90
Office Version
  1. 365
Platform
  1. Windows
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.

1614378116018.png

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.
 
Last edited:
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.
 
Upvote 0

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
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
Rich (BB code):
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.
 
Upvote 0
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?
 
Upvote 0
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?
 
Last edited:
Upvote 0
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:
VBA Code:
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
 
Upvote 0
Solution
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.
 
Upvote 0
Hey Mumps.

Awesome. Works flawlessly.

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

Forum statistics

Threads
1,213,567
Messages
6,114,342
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top