Create a list of all peers from a given Employee List

[bkj_28]

Hi,
Newbie here with very basic knowledge on how to use VBA (not knowledgeable enough to create VBA code). I need some help in creating a list of all peers for a given employee list. Below is a sample:

Employee List​
Emp Name​	Manager Name​
A1​	M1​
A2​	M1​
A3​	M1​
A4​	M2​
A5​	M2​

Output:

List of Peers​
Emp Name​	Peer Name​
A1​	A2​
A1​	A3​
A1​	A4​
A2​	A1​
A2​	A3​
A2​	A4​
A3​	A1​
A3​	A2​
A3​	A4​
A4​	A5​
A5​	A4​

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub bkj()
   Dim Ary As Variant, Nary As Variant, Sp As Variant
   Dim r As Long, nr As Long, i As Long
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   Ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * UBound(Ary), 1 To 2)
   For r = 2 To UBound(Ary)
      Dic(Ary(r, 2)) = Dic(Ary(r, 2)) & "," & Ary(r, 1)
   Next r
   For r = 2 To UBound(Ary)
      Sp = Filter(Split(Mid(Dic(Ary(r, 2)), 2), ","), Ary(r, 1), False)
      For i = 0 To UBound(Sp)
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 1)
         Nary(nr, 2) = Sp(i)
      Next i
   Next r
   Range("E2").Resize(nr, 2).Value = Nary
End Sub

 

[bkj_28]

Hi & welcome to MrExcel.
How about

Sub bkj()
   Dim Ary As Variant, Nary As Variant, Sp As Variant
   Dim r As Long, nr As Long, i As Long
   Dim Dic As Object
  
   Set Dic = CreateObject("scripting.dictionary")
   Ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * UBound(Ary), 1 To 2)
   For r = 2 To UBound(Ary)
      Dic(Ary(r, 2)) = Dic(Ary(r, 2)) & "," & Ary(r, 1)
   Next r
   For r = 2 To UBound(Ary)
      Sp = Filter(Split(Mid(Dic(Ary(r, 2)), 2), ","), Ary(r, 1), False)
      For i = 0 To UBound(Sp)
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 1)
         Nary(nr, 2) = Sp(i)
      Next i
   Next r
   Range("E2").Resize(nr, 2).Value = Nary
End Sub

Thank you for the prompt reply. Had a strange experience implementing it. It worked for the first time when I ran it. However, when I tried to run it again, I kept getting the Run Time Error: 1004 Application-Defined or Object-defined error...

 

[Fluff]

Which line of code gave that error?

 

[bkj_28]

How do I check that?

Actually, I tried it again. It works specifically in the same sheet in which I saved the code. And it also seems to be working with A1, A2 emp codes only. When I try to enter names, it shows me a dialog box with 400 error code..

 

[Fluff]

The code needs to go in a standard module, not a sheet module, & will run on the active sheet.

 

[bkj_28]

Oh.. I tried and it works perfectly! Thank you. I was working on this the whole day without any progress. Your help has saved me considerable stress and provided me with an accurate solution. Thank you. Kudos.

 

[Fluff]

Glad to help & thanks for the feedback.