Center wise duty list creation from an existing mixed duty list

awanak

New Member
Joined
Oct 6, 2018
Messages
37
Office Version
  1. 2019
Platform
  1. Windows
I want to create a center wise duty list from an existing mixed center wise duty list

Mixed center wise duty list
S.No
Name
Center
1
Gul Nisar
Lahore-1
2
Jamil Ahmad Siddiqui
Lahore-5
3
Muhammad Ashraf
Lahore-2
4
Naeem Akhtar
Lahore-4
5
Munir Ahmad Malik
Lahore-2
6
Muhammad Amjad
Lahore-2
7
Muhammad Saleem Arain
Lahore-3
8
Zubair Khan
Lahore-1
9
S.M. Ibrahim
Lahore-1
10
Muhammad Khan
Lahore-7
11
Bashir Ahmad
Lahore-6
12
Naseer Khan
Lahore-9
13
Fida Muhammad
Lahore-2
14
Alam Shah
Lahore-3
15
Asghar Ali Asghar
Lahore-6
16
Mumtaz Ali
Lahore-5
17
Iftikhar Ahmad
Lahore-1
18
Sardar Javed Akhtar
Lahore-6
19
Shoukat Ali Mirza
Islamabad-1
20
Muhammad Boota Asim
Islamabad-1
21
Muhammad Rukhtaj
Lahore-6
22
Tanveer Muhammad Khan
Islamabad-2
23
S.Imran Hassan
Islamabad-2
24
Shakeel Ahmed
Islamabad-1
25
Imran Asghar
Islamabad -1
26
Tariq Ali Lahori
Lahore-1

<tbody>
</tbody>

Center wise Duty list to be created
Name & Center
Islamabad-1
Imran Asghar
Shoukat Ali Mirza
Muhammad Boota Asim
Shakeel Ahmed
Islamabad-2
Tanveer Muhammad
S.Imran Hassan
Lahore-1
Gul Nisar
Zubair Khan
S.M. Ibrahim
Iftikhar Ahmad
Tariq Ali Lahori
Lahore-2
Muhammad Ashraf
Munir Ahmad Malik
Muhammad Amjad
Fida Muhammad
Lahore-3
Muhammad Saleem Arain
Alam Shah
Lahore-4
Naeem Akhtar
Lahore-5
Jamil Ahmad Siddiqui
Mumtaz Ali
Lahore-6
Bashir Ahmad
Asghar Ali Asghar
Sardar Javed Akhtar
Muhammad Rukhtaj
Lahore-7
Muhammad Khan
Lahore-9
Naseer Khan

<tbody>
</tbody>


<tbody>
</tbody>
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
You can do this one of two ways. Using the built in functions, you can sort them based upon the center or you can filter them a center at a time and copy and paste to new worksheets.
 
Upvote 0
these two are quite simple methods, I actually want this to be created automatically and keep on updating upon addition of new data
 
Upvote 0
NO, name and number of locations may change, depending upon number of center to be decided for each exam
 
Upvote 0
Give this a try:-

Data in column "A,B & C"
Results Start "F1"
Code:
[COLOR="Navy"]Sub[/COLOR] MG20Oct23
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, nn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, KK [COLOR="Navy"]As[/COLOR] Variant, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]

[COLOR="Navy"]Set[/COLOR] Rng = Range("C2", Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn.Offset(, -1)
    [COLOR="Navy"]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) & ", " & Dn.Offset(, -1).Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

ReDim Ray(1 To Rng.Count * 2, 1 To 2)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    Txt = Split(K, "-")(0)
    Dic(Txt) = Dic(Txt) + 1
[COLOR="Navy"]Next[/COLOR] K
c = 1
Ray(c, 1) = "Name & Center"
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] KK [COLOR="Navy"]In[/COLOR] Dic.keys
    [COLOR="Navy"]For[/COLOR] n = 1 To Dic(KK) * 2
        [COLOR="Navy"]If[/COLOR] .exists(KK & "-" & n) [COLOR="Navy"]Then[/COLOR]
            c = c + IIf(c = 1, 1, 2)
            Ray(c, 1) = KK & "-" & n
            Sp = Split(.Item(Ray(c, 1)), ", ")
                [COLOR="Navy"]For[/COLOR] nn = 0 To UBound(Sp)
                    c = c + 1
                    Ray(c, 1) = Sp(nn)
                [COLOR="Navy"]Next[/COLOR] nn
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] KK
Range("F1").Resize(c).Value = Ray
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
IF I ENTER Islamabad-13 in center, it does not run at all. there need to be more than 50 center in each location
 
Upvote 0
If you have the code running , but are concerned about the number of centres, then change the line number in red to max number of centres you might have:-
As below:-
Code:
For Each KK In Dic.keys
    For n = 1 To [COLOR="#FF0000"][B]50
[/B][/COLOR]        If .exists(KK & "-" & n) Then
 
Last edited:
Upvote 0
Thanks a lot. it works. if I want to create center wise breakup to sheet2, how will this code be changed then?
 
Upvote 0

Forum statistics

Threads
1,213,539
Messages
6,114,221
Members
448,554
Latest member
Gleisner2

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