VBA code to pick data based on multiple conditions

[tirumal]

Hello guys,



I've been struggling to write this for days macro and I have finally decided to ask for your help.


Here's what I have:



Sheet1 - Job IDs, Assignees and Tasks as headers



A1 - IDs

B1 - Assignees

C1 - Tasks

*Rest of the columns are something i've tried which did not work out.



There are different no. of Jobs in the data and each job has 2 tasks only. The tasks (task1 and task2) of each job are done by either 2 assignees separately or done by the same assignee (for some jobs).



What I am trying to achieve:



- I want to filter data in such a way that the macro should pick only five task1's and task2's of each assignee.

- But ideally, when a task2 of a job is picked, task 1 of the same job should also be picked keeping in mind that the assignee that did that task did not have more than 5 task1;s (or) task2's picked.

- My idea is, the macro should be able to ideally keep a log or delete data no. of tasks of a particular assignee once they reach the threshold of 5.

- To put it in simple terms, the no. of jobs picked do not matter, but both task 1 and 2 of any Job should be picked and each assignee should equally have 5 task1 and task2's.



I had multiple attempts but I have failed miserably. I would be really grateful if someone helps me out.

*Please find the file link here

Thank you,
Tirumal

 

[Yongle]

This is the upside down version of previous approach which simplifies everything unbelievably
The sheet is copied in full and unwanted values are deleted
It makes the code much simpler and faster
(eg both legs of a job are kept together and VBA does not need to find the 2nd leg each time etc)
You will still get some bigger outliers - it depends on which 2 managers are allocated to a job
But all managers with smaller allocations receive 100%

The higher the two count values, the more jobs remain on the sheet

Test it and see what you think - hopefully I have not missed anything obvious!

Delete the whole of the previous code and replace with this SINGLE procedure

Option Explicit

Dim wf As WorksheetFunction
Dim ID As Range, Mgr As Range, Opt As Range
Dim A2 As Range, B2 As Range, C2 As Range
Dim ws2 As Worksheet, rng As Range, lastR As Long, r As Long
Dim count1 As Long, count2 As Long

Sub AllocateJobID()
    Application.ScreenUpdating = False
    Set wf = Application.WorksheetFunction
'sort original data by job number first
    With Sheets("Sheet1")
        .Sort.SortFields.Clear
        lastR = .Range("A" & Rows.Count).End(xlUp).Row
        With .Range("A2:C" & lastR)
            .Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo
        End With
'add sheet
        .Copy after:=Sheets(Sheets.Count)
    End With
'set ranges in new sheet
    Set ws2 = Sheets(Sheets.Count)
    
    With ws2
        Set A2 = .Range("A:A")
        Set B2 = .Range("B:B")
        Set C2 = .Range("C:C")
    End With
'loop through values
    For r = 2 To lastR Step 2
        With ws2
            Set ID = .Cells(r, 1)
            Set Mgr = .Cells(r, 2)
            Set Opt = .Cells(r, 3)
            Set rng = .Cells(r, 1).Resize(2, 3)
            'ensure both elements of the job satisfy the condition
            If ID = ID.Offset(1) Then
                If wf.CountIfs(B2, Mgr, C2, Opt) > 5 And wf.CountIfs(B2, Mgr.Offset(1), C2, Opt.Offset(1)) > 5 Then rng.ClearContents
            Else
                GoTo Problem
            End If
        End With
    Next r
    On Error Resume Next        'do not remove this line - code fails if special cells finds nothing
    A2.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Exit Sub
Problem: MsgBox "Job " & ID & vbCr & "in row " & r, vbExclamation, "JOB ENTRY MISSING"

End Sub

 

[Yongle]

deleted by Yongle

 

[tirumal]

This is the upside down version of previous approach which simplifies everything unbelievably
The sheet is copied in full and unwanted values are deleted
It makes the code much simpler and faster
(eg both legs of a job are kept together and VBA does not need to find the 2nd leg each time etc)
You will still get some bigger outliers - it depends on which 2 managers are allocated to a job
But all managers with smaller allocations receive 100%

The higher the two count values, the more jobs remain on the sheet

Test it and see what you think - hopefully I have not missed anything obvious!

Delete the whole of the previous code and replace with this SINGLE procedure

Option Explicit

Dim wf As WorksheetFunction
Dim ID As Range, Mgr As Range, Opt As Range
Dim A2 As Range, B2 As Range, C2 As Range
Dim ws2 As Worksheet, rng As Range, lastR As Long, r As Long
Dim count1 As Long, count2 As Long

Sub AllocateJobID()
    Application.ScreenUpdating = False
    Set wf = Application.WorksheetFunction
'sort original data by job number first
    With Sheets("Sheet1")
        .Sort.SortFields.Clear
        lastR = .Range("A" & Rows.Count).End(xlUp).Row
        With .Range("A2:C" & lastR)
            .Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo
        End With
'add sheet
        .Copy after:=Sheets(Sheets.Count)
    End With
'set ranges in new sheet
    Set ws2 = Sheets(Sheets.Count)
   
    With ws2
        Set A2 = .Range("A:A")
        Set B2 = .Range("B:B")
        Set C2 = .Range("C:C")
    End With
'loop through values
    For r = 2 To lastR Step 2
        With ws2
            Set ID = .Cells(r, 1)
            Set Mgr = .Cells(r, 2)
            Set Opt = .Cells(r, 3)
            Set rng = .Cells(r, 1).Resize(2, 3)
            'ensure both elements of the job satisfy the condition
            If ID = ID.Offset(1) Then
                If wf.CountIfs(B2, Mgr, C2, Opt) > 5 And wf.CountIfs(B2, Mgr.Offset(1), C2, Opt.Offset(1)) > 5 Then rng.ClearContents
            Else
                GoTo Problem
            End If
        End With
    Next r
    On Error Resume Next        'do not remove this line - code fails if special cells finds nothing
    A2.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Exit Sub
Problem: MsgBox "Job " & ID & vbCr & "in row " & r, vbExclamation, "JOB ENTRY MISSING"

End Sub

Wow! It truly does the job. It has fixed so many things from the previous code. Runs faster as well and True - false distribution is truly equal. Although the code is working at it's best, i can still see few outliers as you already mentioned. These managers have a higher overall job count as well.

Allocation test.xlsm
	A	B	C	D
4	Row Labels	TRUE	FALSE	Grand Total
5	ayumishr	80	50	130
6	kuniarun	74	50	124
7	biswadm	64	50	114
8	snghoj	64	52	116
9	saithom	53	50	103
10	mnallan	50	50	100
11	skaveesh	50	50	100
12	panchada	50	50	100
13	bippakay	50	50	100
14	tulap	50	50	100
15	alfrdav	50	50	100
Pivot 3

The distribution of True is significantly High. By numbers 14-30 (Almost 20-30%). Which then creates unequal distribution for these guys ONLY. Also False is higher for few no. of people:

Allocation test.xlsm
	A	B	C	D
4	Row Labels	TRUE	FALSE	Grand Total
5	nikumark	50	64	114
6	charchv	50	56	106
7	abbaksh	50	52	102
Pivot 3

I know this is because of the given managers' data in the raw data, but is there a fix for this so there is a lesser significant number for these outliers? Ex. max upto +5 to 10

 

[tirumal]

I've set the number to 60 (as that is my true allocation number, not 5) and tried it with a different set of data which has similar columns and this is the output -

almost 50% increase in true allocation for one particular manager:

Allocation test.xlsm
	A	B	C	D
4	Row Labels	TRUE	FALSE	Grand Total
5	snghoj	108	60	168
6	biswadm	86	60	146
7	saithom	78	60	138
8	glenmart	71	60	131
9	wajakhan	70	60	130
10	blbi	61	60	121
11	skaveesh	60	60	120
12	sanikh	60	60	120
13	tulap	60	60	120
Sheet7

 

[Yongle]

Glad that moved things in the right direction
- it was becoming more and more complicated using the original approach

Without using an optimisation technique, which would involve multiple runs, there is no way to guarantee that you will get the output you need
- but a 2nd trawl through the data with a different test may get it closer

Will look at that tomorrow

 

[tirumal]

I've set the number to 60 (as that is my true allocation number, not 5) and tried it with a different set of data which has similar columns and this is the output -

almost 50% increase in true allocation for one particular manager:

Allocation test.xlsm
	A	B	C	D
4	Row Labels	TRUE	FALSE	Grand Total
5	snghoj	108	60	168
6	biswadm	86	60	146
7	saithom	78	60	138
8	glenmart	71	60	131
9	wajakhan	70	60	130
10	blbi	61	60	121
11	skaveesh	60	60	120
12	sanikh	60	60	120
13	tulap	60	60	120
Sheet7

Attaching the data set (macro-free) that returned the aforementioned error. In case if you wanna test on this data, please use 60 as the number (instead of 5).

File Link: Click here

 

[Yongle]

Having considered it further...
- the data layout is unhelpful
- it would be simpler (for may reasons) if data consisted ONE line per JOBNo
- reducing the number of lines will make VBA faster
- alternative layout (see below) allows for various values to be put against each JobNo (by VBA or formula)
- those values could then be used to filter the data for best-fit

Q1Do you have any objections to this approach ?
Q2 Are you able to get your data laid out as in columns A,B,C below ?
(could use VBA to convert if necessary)

Book1
	A	B	C	D	E	F
1	Job ID	True	False	Count of TRUE Manager	Count of FALSE Manager	Variance
2	000064c8e46c47cb9979dcc0268f223d	mmmadhr	bjjosh	3	3	0
3	0025cfb502dc4ff1833ce4ee36855055	agangele	wajakhan	3	3	0
4	00434abee4e84c2f9785d6da6e149211	nkakulla	mmmadhr	4	4	0
5	00494aee7a0a40e1b7c8ae4c376491c5	vnchan	nkakulla	4	4	0
6	A00434abee4e84c2f9785d6da6e149211	nkakulla	mmmadhr	4	4	0
7	A00494aee7a0a40e1b7c8ae4c376491c5	vnchan	nkakulla	4	4	0
8	B000064c8e46c47cb9979dcc0268f223d	mmmadhr	bjjosh	3	3	0
9	B0025cfb502dc4ff1833ce4ee36855055	agangele	wajakhan	3	3	0
10	B00434abee4e84c2f9785d6da6e149211	nkakulla	mmmadhr	4	4	0
11	B00494aee7a0a40e1b7c8ae4c376491c5	vnchan	nkakulla	4	4	0
12	C000064c8e46c47cb9979dcc0268f223d	mmmadhr	bjjosh	3	3	0
13	C0025cfb502dc4ff1833ce4ee36855055	agangele	wajakhan	3	3	0
14	C00434abee4e84c2f9785d6da6e149211	nkakulla	mmmadhr	4	4	0
15	C00494aee7a0a40e1b7c8ae4c376491c5	vnchan	nkakulla	4	4	0
16	0042544166e14942b4526401ba60dfcf	rdnsh	siaditi	4	6	2
17	A000064c8e46c47cb9979dcc0268f223d	bjjosh	yongle	2	4	2
18	A00110102441d4b478512d5e7691249dd	bjjosh	yongle	2	4	2
19	A001bce89bdba412a9120e6d86346509e	yongle	siaditi	4	6	2
20	A0025cfb502dc4ff1833ce4ee36855055	yongle	siaditi	4	6	2
21	A0042544166e14942b4526401ba60dfcf	rdnsh	siaditi	4	6	2
22	B0042544166e14942b4526401ba60dfcf	rdnsh	siaditi	4	6	2
23	C0042544166e14942b4526401ba60dfcf	rdnsh	siaditi	4	6	2
24	00110102441d4b478512d5e7691249dd	sattili	sattili	3	6	3
25	0029b3cdad244e6e9489f6cdcb4ccdd7	snghoj	snghoj	7	4	3
26	A0002cfccbfb2485cb46ca73a465f76f6	yongle	vnchan	4	1	3
27	A002646548b2e4428aa059dbacbc7dc92	yongle	mtshah	4	1	3
28	A0029b3cdad244e6e9489f6cdcb4ccdd7	snghoj	snghoj	7	4	3
29	A004d143185fd4fceb8ef53eb9dca1384	saithom	sattili	3	6	3
30	B00110102441d4b478512d5e7691249dd	sattili	sattili	3	6	3
31	B0029b3cdad244e6e9489f6cdcb4ccdd7	snghoj	snghoj	7	4	3
32	B004d143185fd4fceb8ef53eb9dca1384	saithom	sattili	3	6	3
33	C00110102441d4b478512d5e7691249dd	sattili	sattili	3	6	3
34	C0029b3cdad244e6e9489f6cdcb4ccdd7	snghoj	snghoj	7	4	3
35	C004d143185fd4fceb8ef53eb9dca1384	saithom	sattili	3	6	3
36	002701827ff64d5a99c03e8794b481d1	snghoj	alfrdav	7	3	4
37	B002701827ff64d5a99c03e8794b481d1	snghoj	alfrdav	7	3	4
38	C002701827ff64d5a99c03e8794b481d1	snghoj	alfrdav	7	3	4
39	0029c74095cb4c5f848beb7bf158f630	mtshah	skaveesh	9	4	5
40	A001df3620e524224b4cd43d6575f8a63	mtshah	yongle	9	4	5
41	A002701827ff64d5a99c03e8794b481d1	mtshah	yongle	9	4	5
42	A0029c74095cb4c5f848beb7bf158f630	mtshah	skaveesh	9	4	5
43	B0029c74095cb4c5f848beb7bf158f630	mtshah	skaveesh	9	4	5
44	C0029c74095cb4c5f848beb7bf158f630	mtshah	skaveesh	9	4	5
45	0002cfccbfb2485cb46ca73a465f76f6	biswadm	rdnsh	9	3	6
46	001bce89bdba412a9120e6d86346509e	mtshah	sshaka	9	3	6
47	001df3620e524224b4cd43d6575f8a63	biswadm	elisaty	9	3	6
48	002646548b2e4428aa059dbacbc7dc92	biswadm	nikumark	9	3	6
49	B0002cfccbfb2485cb46ca73a465f76f6	biswadm	rdnsh	9	3	6
50	B001bce89bdba412a9120e6d86346509e	mtshah	sshaka	9	3	6
51	B001df3620e524224b4cd43d6575f8a63	biswadm	elisaty	9	3	6
52	B002646548b2e4428aa059dbacbc7dc92	biswadm	nikumark	9	3	6
53	C0002cfccbfb2485cb46ca73a465f76f6	biswadm	rdnsh	9	3	6
54	C001bce89bdba412a9120e6d86346509e	mtshah	sshaka	9	3	6
55	C001df3620e524224b4cd43d6575f8a63	biswadm	elisaty	9	3	6
56	C002646548b2e4428aa059dbacbc7dc92	biswadm	nikumark	9	3	6
Sheet2

 

[tirumal]

Sorting data that way should not be a problem as long as it satisfies the conditions.
But im not able to figure out how to separate data that way. A VBA would help if we could sort out data that way and while putting these results out in other sheet, re-sort the results/allocation as per the original format.

 

[Yongle]

Before converting to the new format we must make sure that data is 100% valid (otherwise VBA will ruin the data in output sheet)

Are you able to GUARANTEE that your data is 100% correct in these ways
- EVERY JobNo contains EXACTLY 2 lines
- EVERY JobNo contains one TRUE and one FALSE
- EVERY JobNo contains 2 names

Or is it better if VBA checks the data ?

 

[tirumal]

-I can guarantee with the first 2 points is 100% correct.
-Coming to the third, EVERY JobNo contains two names, YES!
-But some of the JobNo's contains same name for both TRUE and FALSE.