Sort names (first,last) into correct columns

I have 3 columns of names (first, middle and last) but each row is in a different order.

ie-

first last middle
last first middle
middle last first
last middle first
...

I have another list of names (on the 2nd sheet) in the correct order.

I need to rearrange the first list into the correct columns,
being careful of people with the same last names.

The second list is shorter as some people no longer work here, also the middle names are generally not known, they dont matter as much.

I know it may not be possible to sort them all out but how much can be done?

See the attached workbook.

Hi

See how this goes for a start.

Make sure you are on the Unordered Names sheet when you run it.

Sub aaa()
'AUTHOR: rylo
'DATE: 21/9/07
'REFERENCE: http://www.excelforum.com/showthread.php?t=615533
  Dim rngKnown As Range
  Set rngKnown = Sheets("Known Current Employees").Range("A:C")
  'process all single entry surnames
  For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If WorksheetFunction.CountIf(rngKnown, ce.Value) = 1 Then
      Set findit = rngKnown.Find(what:=ce.Value, lookat:=xlWhole)
      If findit.Column = 3 Then 'Cells(ce.Row, "G").Value = ce.Value
        holder = ""
        On Error Resume Next
        holder = WorksheetFunction.Match(ce.Offset(0, 1).Value, findit.EntireRow, 0)
        On Error GoTo 0
        If holder <> "" Then
          Cells(ce.Row, "G").Value = ce.Value
          Cells(ce.Row, "D").Offset(0, holder).Value = ce.Offset(0, 1).Value
          If Not IsEmpty(ce.Offset(0, 2)) Then
            Cells(ce.Row, "D").Offset(0, 3 - holder).Value = ce.Offset(0, 2).Value
          End If
        End If
        
      End If
    End If
  
  Next ce
  
  'process multi entry surnames
  For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If WorksheetFunction.CountIf(rngKnown, ce.Value) > 1 Then
      'Debug.Assert ce.Value <> "Sutton"
      Set findit = rngKnown.Find(what:=ce.Value, lookat:=xlWhole)
      firstadd = findit.Address
      foundit = False
      Do
        holder = ""
        On Error Resume Next
        holder = WorksheetFunction.Match(ce.Offset(0, 1).Value, findit.EntireRow, 0)
        On Error GoTo 0
        If holder <> "" Then
          Cells(ce.Row, "G").Value = ce.Value
          Cells(ce.Row, "D").Offset(0, holder).Value = ce.Offset(0, 1).Value
          foundit = True
          If Not IsEmpty(ce.Offset(0, 2)) Then
            Cells(ce.Row, "D").Offset(0, 3 - holder).Value = ce.Offset(0, 2).Value
          End If
        End If
          
        Set findit = rngKnown.Find(what:=ce.Value, lookat:=xlWhole, after:=findit)
      Loop Until findit.Address = firstadd Or foundit
    End If
  Next ce
          
End Sub

rylo

Yea, very nice.
Thanks.