Auto Sort from multiple list by Name

[hajiali]

hello All,

I have a list column A is First Name Column B is Last name column C I have


C2=

CONCATENATE(B2,","," ",A2)

Puts it in "Last name, First Name"

What im needing done on another sheet is to automatically sort when a name is added/deleted from the list in Alphabetical order based on Last name than if last name are the same By first name,

Any suggestion is greatly appreciated

 

[pbornemeier]

The worksheet holding the names should be named 'Names'
The worksheet holding the sorted list should be named 'Sorted'
I am assuming your names list has a header row, sot it is not included in the sort

Option Explicit

'Put this event trigger sub on the code page of the sheet that holds the
'  3 columns being edited.  It will trigger when the sheet recalculates
'Recalculation will occur if in Automatic mode when the column C cell
'  with the formula is copied/dragged to a new cell

Private Sub Worksheet_Calculate()
    CopyAndSortNames
End Sub

'Add this Sub to a standard module

Option Explicit

Sub CopyAndSortNames()
    'Erase the 'Sorted' worksheet
    'Copy the name list on the 'Names' worksheet to the 'Sorted' worksheet
    'Sort by column C
    
    Dim lLastRow As Long
    
    Worksheets("Sorted").Cells.ClearContents
    With Worksheets("Names")
        lLastRow = .Cells(.Rows.Count, 3).End(xlUp).Row 'Last populated cell in column C
        .Range("A1:C" & lLastRow).Copy
    End With
    With Worksheets("Sorted")
        .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("C1:C" & lLastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Sorted").Sort
            .SetRange ActiveWorkbook.Worksheets("Sorted").Range("A1:C" & lLastRow)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Select
        .Range("A1").Select
    
    End With
End Sub

 

[DanteAmor]

How about this shorter code.

Sub CopyAndSortNames()
  Dim sh2 As Worksheet
  Application.ScreenUpdating = False
  Set sh2 = Sheets("[COLOR=#0000ff]Sorted[/COLOR]")
  Sheets("[COLOR=#0000ff]Names[/COLOR]").Range("A:C").Copy
  sh2.Range("A1").PasteSpecial xlPasteValues
  sh2.Range("A:C").Sort key1:=sh2.Range("B1"), order1:=xlAscending, Header:=xlYes
  Application.CutCopyMode = False
End Sub

 

[pbornemeier]

It is indeed shorter, but be sure to clear the sorted worksheet before copying rows from names in case some rows were removed from the original list.

 

[DanteAmor]

It is indeed shorter, but be sure to clear the sorted worksheet before copying rows from names in case some rows were removed from the original list.

Thanks for the observation. It is not necessary to delete previously, since I am copying the entire columns.

 

[pbornemeier]

Thanks for pointing that out...I am not being very observant with this one.