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

 

[tirumal]

Example:

Allocation test.xlsm
	A	B	C
1	Job ID	TRUE	FALSE
2	000064c8e46c47cb9979dcc0268f223d	mmmadhr	bjjosh
3	0002cfccbfb2485cb46ca73a465f76f6	biswadm	rdnsh
4	00110102441d4b478512d5e7691249dd	sattili	sattili
5	001bce89bdba412a9120e6d86346509e	mtshah	sshaka
6	001df3620e524224b4cd43d6575f8a63	biswadm	elisaty
7	0025cfb502dc4ff1833ce4ee36855055	agangele	wajakhan
8	002646548b2e4428aa059dbacbc7dc92	biswadm	nikumark
9	002701827ff64d5a99c03e8794b481d1	snghoj	alfrdav
10	0029b3cdad244e6e9489f6cdcb4ccdd7	snghoj	snghoj
11	0029c74095cb4c5f848beb7bf158f630	mtshah	skaveesh
12	0042544166e14942b4526401ba60dfcf	rdnsh	siaditi
13	00434abee4e84c2f9785d6da6e149211	nkakulla	mmmadhr
14	00494aee7a0a40e1b7c8ae4c376491c5	vnchan	nkakulla
15	004d143185fd4fceb8ef53eb9dca1384	saithom	sattili
16	00544b4cc26f4a05995232dfeb9e5f63	mnallan	biswadm
17	005518a198e84fb788d98cf649953b94	mtshah	nkakulla
18	005abccbd39442c584d3899d13566326	nikumark	snghoj
19	005b7f3c92454608806ce1e0b57b9b7a	wajakhan	wajakhan
Sheet2

 

[Yongle]

Perfect answer
My next post will include data conversion procedure for you to test

 

[Yongle]

Put this in a new module and run Master to test conversion

Option Explicit

Dim wf As WorksheetFunction
Dim ID As Range, mT As Range, mF 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

Sub Master()
    Application.ScreenUpdating = False
    CreateNewLayout
End Sub

Private Sub CreateNewLayout()
    Set wf = Application.WorksheetFunction
'copy to new sheet and sort
    Sheets("Sheet1").Copy after:=Sheets(Sheets.Count)
    Set ws2 = Sheets(Sheets.Count)
    With ws2
        lastR = .Range("A" & .Rows.Count).End(xlUp).Row
        With .Range("A2:C" & lastR)
            .Sort Key1:=.Range("C2"), Order1:=xlDescending, Header:=xlNo
            .Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo
        End With
    End With
'new layout
    With ws2
        .Range("B3:B" & lastR).Copy .Range("D2")
        .Range("A1:A" & lastR).AutoFilter Field:=3, Criteria1:="FALSE"
        .Range("A2:A" & lastR + 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .Range("D1") = "False"
        .Range("B1") = "True"
        .Range("C1").EntireColumn.Delete
    End With
'set ranges
    With ws2
        Set A2 = .Range("A:A")
        Set B2 = .Range("B:B")
        Set C2 = .Range("A:B")
    End With
End Sub

 

[tirumal]

Conversion is working perfectly!

 

[tirumal]

No, there's actually some problem.

-It's giving this error "Identifier under cursor not recognized" for this line:

.Range("A1:A" & lastR).AutoFilter Field:=3, Criteria1:="FALSE"

It's printing the output in the other sheet this way:

Allocation test.xlsm
	A	B	C	D
1	Job ID	Manager	Dislike Option
2	000064c8e46c47cb9979dcc0268f223d	mmmadhr	TRUE	bjjosh
3	000064c8e46c47cb9979dcc0268f223d	bjjosh	FALSE	biswadm
4	0002cfccbfb2485cb46ca73a465f76f6	biswadm	TRUE	rdnsh
5	0002cfccbfb2485cb46ca73a465f76f6	rdnsh	FALSE	sattili
6	00110102441d4b478512d5e7691249dd	sattili	TRUE	sattili
7	00110102441d4b478512d5e7691249dd	sattili	FALSE	mtshah
8	001bce89bdba412a9120e6d86346509e	mtshah	TRUE	sshaka
9	001bce89bdba412a9120e6d86346509e	sshaka	FALSE	biswadm
10	001df3620e524224b4cd43d6575f8a63	biswadm	TRUE	elisaty
11	001df3620e524224b4cd43d6575f8a63	elisaty	FALSE	agangele
Sheet1 (2)

This is the end of the sheet in the new output:

Allocation test.xlsm
	A	B	C	D
19969	fff8458cdf2d405a813dc693d2441dcc	tulap	FALSE	sshaka
19970	fffcfac678cc409da81821f2035f719e	sshaka	TRUE	nkakulla
19971	fffcfac678cc409da81821f2035f719e	nkakulla	FALSE	mnallan
19972	fffeb549300244e7a619baed7fcacc99	mnallan	TRUE	sshaka
19973	fffeb549300244e7a619baed7fcacc99	sshaka	FALSE
Sheet1 (2)

 

[Yongle]

Try changing
.Range("A1:A" & lastR).AutoFilter Field:=3, Criteria1:="FALSE"
To
.Range("A1:A" & lastR).AutoFilter Field:=3, Criteria1:=FALSE

 

[tirumal]

Still returning the same error unfortunately
Also, D2 needs to be defined right?

.Range("B3:B" & lastR).Copy .Range("D2")

 

[tirumal]

This sorting VBA can be addressed later, i guess. For now i'll use few formulas and paste the data in the order you suggested. I'm curious to try the latest code for allocation.

 

[Yongle]

-It's giving this error "Identifier under cursor not recognized"

Ah - worked it out
Data filter was already enabled on my sheet1 - so that was copied across when sheet copied - oops!

Insert this
.Range("A1").AutoFilter

Above
.Range("A1:A" & lastR).AutoFilter Field:=3, Criteria1:=FALSE

Also, D2 needs to be defined right?

- the dot( . ) does that
- the code is correct

 

[tirumal]

Perfect! Cross - Checked with real data too.

Allocation test.xlsm
	A	B	C
1	Job ID	TRUE	FALSE
2	000064c8e46c47cb9979dcc0268f223d	mmmadhr	bjjosh
3	0002cfccbfb2485cb46ca73a465f76f6	biswadm	rdnsh
4	00110102441d4b478512d5e7691249dd	sattili	sattili
5	001bce89bdba412a9120e6d86346509e	mtshah	sshaka
6	001df3620e524224b4cd43d6575f8a63	biswadm	elisaty
7	0025cfb502dc4ff1833ce4ee36855055	agangele	wajakhan
8	002646548b2e4428aa059dbacbc7dc92	biswadm	nikumark
9	002701827ff64d5a99c03e8794b481d1	snghoj	alfrdav
10	0029b3cdad244e6e9489f6cdcb4ccdd7	snghoj	snghoj
Sheet1 (2)