Center wise duty list creation from an existing mixed duty list

[awanak]

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>

 

[MickG]

The "Center" Column !!
Alter code as below in Red:-

For Each Dn In Rng
  [COLOR="#FF0000"][B]If Not Dn.Value = vbNullString Then
[/B][/COLOR]    If Not .Exists(Dn.Value) Then
        .Add Dn.Value, Dn.Offset(, -3) & ", " & Dn.Offset(, -2).Value & " (" & Dn.Offset(, -1).Value & ")"
    Else
        .Item(Dn.Value) = .Item(Dn.Value) & "/" & Dn.Offset(, -3) & ", " & Dn.Offset(, -2).Value & " (" & Dn.Offset(, -1).Value & ")"
    End If
  [COLOR="#FF0000"][B]End If
[/B][/COLOR]Next

 

[awanak]

Bundle of thanks dear. stay blessed

 

[MickG]

You're welcome

 

[awanak]

I have another question,
I have detail of centers with the date of exams at sheet3 as given below

Center	Dates
Lahore-1	10.11.2018 to 20.11.2018
Lahore-2	11.11.2018 to 15.11.2018
Islamabad-1	12.11.2018 to 15.112018
Karachi-2	11.11.2018 to 15.11.2018
Lahore-1	10.11.2018 to 20.11.2018

<tbody>
</tbody>

I want to pick up the date when i enter the center name of an employee as given below pn sheet 1.

S.No	Name	Designaiton	Place of Postings	Center	Dates
1	A	DG	CE Wing	Lahore-1	10.11.2018 to 20.11.2018
2	B	DG	Recruitment Wing	Lahore-2	11.11.2018 to 15.11.2018
3	C	DG	C&R Wing	Islamabad-1	12.11.2018 to 15.112018
4	D	Chief	IT Wing	Karachi-2	11.11.2018 to 15.11.2018
5	D	DG	Admin Wing	Lahore-1	10.11.2018 to 20.11.2018​ <strike></strike>

<tbody>
</tbody>

<strike></strike>

 

[MickG]

Try this in your Sheet 1 module
This is a Change event, so when a value is changed in column "E" the Related date (from sheet3)should appear in column "F".

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
Application.EnableEvents = False
[COLOR="Navy"]If[/COLOR] Target.Column = 5 And Target.Count = 1 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet3")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Target.Value = Dn.Value [COLOR="Navy"]Then[/COLOR]
        Target.Offset(, 1).Value = Dn.Offset(, 1).Value
        [COLOR="Navy"]Exit[/COLOR] For
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[awanak]

sheet 1 already has the following code. how will the above code be nested into it

Sub MG21Oct21()
Dim Rng As Range, Dn As Range, n As Long, Dic As Object, nn As Long, Sp As Variant, c As Long
Dim K As Variant, KK As Variant, Txt As String


Set Rng = Range("E2", Range("E" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare


For Each Dn In Rng
If Not Dn.Value = vbNullString Then
If Not .Exists(Dn.Value) Then
.Add Dn.Value, Dn.Offset(, -3) & ", " & Dn.Offset(, -2).Value & " (" & Dn.Offset(, -1).Value & ")"
Else
.Item(Dn.Value) = .Item(Dn.Value) & "/" & Dn.Offset(, -3) & ", " & Dn.Offset(, -2).Value & " (" & Dn.Offset(, -1).Value & ")"
End If
End If
Next
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare


ReDim Ray(1 To Rng.Count * 3, 1 To 2)
For Each K In .keys
Txt = Split(K, "-")(0)
Dic(Txt) = Dic(Txt) + 1
Next K
c = 1
Ray(c, 1) = "Center:=Name/Desg/Post"
For Each KK In Dic.keys
For n = 1 To Rng.Count * 3
If .Exists(KK & "-" & n) Then
c = c + IIf(c = 1, 1, 2)
Ray(c, 1) = KK & "-" & n
Sp = Split(.Item(Ray(c, 1)), "/")
For nn = 0 To UBound(Sp)
c = c + 1
Ray(c, 1) = Sp(nn)
Next nn
End If
Next n
Next KK
With Sheets("Sheet2").Range("B1").Resize(c)
.Value = Ray
.Borders.Weight = 2
.Columns.AutoFit
End With
End With
End Sub

 

[MickG]

The latest code is a "Change_Event" code, and works separately from the previous code

This is a Change event, so when a value is changed in column "E" the Related date (from sheet3)should appear in column "F".

To load the code:-
Right click sheet1 tab, Select "View Code" , vbwindow appears, Paste code into vbwindow.
Close Vbwindow
When you now enter a "Center" in column "E" the related "Date" from sheet3 should show in column "F".