Center wise duty list creation from an existing mixed duty list

awanak

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
[TABLE="width: 302"]
<tbody>[TR]
[TD]S.No
[/TD]
[TD]Name
[/TD]
[TD]Center
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Gul Nisar
[/TD]
[TD]Lahore-1
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Jamil Ahmad Siddiqui
[/TD]
[TD]Lahore-5
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]Muhammad Ashraf
[/TD]
[TD]Lahore-2
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]Naeem Akhtar
[/TD]
[TD]Lahore-4
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]Munir Ahmad Malik
[/TD]
[TD]Lahore-2
[/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]Muhammad Amjad
[/TD]
[TD]Lahore-2
[/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]Muhammad Saleem Arain
[/TD]
[TD]Lahore-3
[/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]Zubair Khan
[/TD]
[TD]Lahore-1
[/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]S.M. Ibrahim
[/TD]
[TD]Lahore-1
[/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]Muhammad Khan
[/TD]
[TD]Lahore-7
[/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]Bashir Ahmad
[/TD]
[TD]Lahore-6
[/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD]Naseer Khan
[/TD]
[TD]Lahore-9
[/TD]
[/TR]
[TR]
[TD]13
[/TD]
[TD]Fida Muhammad
[/TD]
[TD]Lahore-2
[/TD]
[/TR]
[TR]
[TD]14
[/TD]
[TD]Alam Shah
[/TD]
[TD]Lahore-3
[/TD]
[/TR]
[TR]
[TD]15
[/TD]
[TD]Asghar Ali Asghar
[/TD]
[TD]Lahore-6
[/TD]
[/TR]
[TR]
[TD]16
[/TD]
[TD]Mumtaz Ali
[/TD]
[TD]Lahore-5
[/TD]
[/TR]
[TR]
[TD]17
[/TD]
[TD]Iftikhar Ahmad
[/TD]
[TD]Lahore-1
[/TD]
[/TR]
[TR]
[TD]18
[/TD]
[TD]Sardar Javed Akhtar
[/TD]
[TD]Lahore-6
[/TD]
[/TR]
[TR]
[TD]19
[/TD]
[TD]Shoukat Ali Mirza
[/TD]
[TD]Islamabad-1
[/TD]
[/TR]
[TR]
[TD]20
[/TD]
[TD]Muhammad Boota Asim
[/TD]
[TD]Islamabad-1
[/TD]
[/TR]
[TR]
[TD]21
[/TD]
[TD]Muhammad Rukhtaj
[/TD]
[TD]Lahore-6
[/TD]
[/TR]
[TR]
[TD]22
[/TD]
[TD]Tanveer Muhammad Khan
[/TD]
[TD]Islamabad-2
[/TD]
[/TR]
[TR]
[TD]23
[/TD]
[TD]S.Imran Hassan
[/TD]
[TD]Islamabad-2
[/TD]
[/TR]
[TR]
[TD]24
[/TD]
[TD]Shakeel Ahmed
[/TD]
[TD]Islamabad-1
[/TD]
[/TR]
[TR]
[TD]25
[/TD]
[TD]Imran Asghar
[/TD]
[TD]Islamabad -1
[/TD]
[/TR]
[TR]
[TD]26
[/TD]
[TD]Tariq Ali Lahori
[/TD]
[TD]Lahore-1
[/TD]
[/TR]
</tbody>[/TABLE]

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

[TABLE="width: 271"]
<tbody>[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
To show the results on sheet2 then:-
Alter this line :-
Code: 
Range("F1").Resize(c).Value = Ray

To this:-
Code: 
sheets("Sheet2").Range("A1").Resize(c).Value = Ray
 
Upvote 0

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
thanks buddy, got the desired output on sheet2, however, when i enter a center name and number e.g. Skardu-1, it gives the error "Subscript out of range". This center is most probably 7th or 8th center name. need help for entering multiple center names and numbers around 150 or more centers are to be setup for exam
 
Upvote 0
Try changing the line below to "3"
Code: 
ReDim Ray(1 To Rng.Count *[COLOR="#FF0000"][B][SIZE=3] 3[/SIZE][/B][/COLOR], 1 To 2)
 
Upvote 0
Thanks a lot. it works. another question is that, if i have the original duty list to be as under [TABLE="width: 496"]
<colgroup><col><col><col><col><col></colgroup><tbody>[TR]
[TD]S.No[/TD]
[TD]Name[/TD]
[TD]Designaiton[/TD]
[TD]Place of Postings[/TD]
[TD]Center[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Gul Nisar[/TD]
[TD]Assistant[/TD]
[TD]CE Directorate[/TD]
[TD]Lahore-1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
I want create center wise duty list but with the format as given below:
Lahore-1
Gul Nisar, Assistant (CE Directorate)
 
Upvote 0
Try this:-

Code: 
[COLOR="Navy"]Sub[/COLOR] MG21Oct21
[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("E2", Range("E" & 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(, -3) & ", " & Dn.Offset(, -2).Value & " (" & Dn.Offset(, -1).Value & ")"
    [COLOR="Navy"]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) & "/" & Dn.Offset(, -3) & ", " & Dn.Offset(, -2).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 * 3, 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) = "Center:=Name/Desg/Post"
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] KK [COLOR="Navy"]In[/COLOR] Dic.keys
    [COLOR="Navy"]For[/COLOR] n = 1 To 50
        [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
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c)
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks Mick. there is a problem, when there are blanks in between centers assigned to different employees, it gives the error "Subscript out of range". moverover, i have more than 650 employees and almost 600 are assigned duties at different cities with different center numbers.
 
Upvote 0
I've altered the code slightly to increase the array dimensions, and tried on 2000plus rows with multiple and single employees without error.
If this does not work for you, can you sent a redacted file of the data that fails, using "Box" or "DropBox"
Mod to code:-
Change line in red
Code: 
For Each KK In Dic.Keys
    [COLOR="#FF0000"]For n = 1 To Rng.Count * 3
[/COLOR]        If .Exists(KK & "-" & n) Then
 
Upvote 0
If some of the cells are blank in the center, the same error occurs "Subscript out of range"
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Find entries in a sheet available or not
2
Replies
10
Views
494
AFZAL SOHAIL
A

Forum statistics

Threads
1,224,830
Messages
6,181,227
Members
453,025
Latest member
Hannah_Pham93

Share this page

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