Alphabetize client’s last name on seperate sheet

[ABabeNChrist]

Hi
I have a worksheet named “Sales” that I that use to keep records of my client’s information on. The way I use my worksheet named “Sales” at the present moment is when a new clients information is entered it will go onto the next available row. This has been working great for a long time, but with this long time comes a lot of different client information. What I’d like to be able to do is on another sheet named “Contact” is to alphabetize client’s last name on sheet “Contact” with corresponding date and phone # in the next 2 columns following. The client’s name is layout like so John T Smith, first, middle and then last name and some names may not have a middle name.
On worksheet sales they are entered like so.
Column A is Date
Column B is Client Name
Column H is Phone #

[HansV]

Why create a separate sheet? You can add a column to the Sales sheet with a formula to display the name in Last, First Middle order:

=RIGHT(B2,LEN(B2)-IFERROR(FIND(" ",B2,FIND(" ",B2)+1),FIND(" ",B2)))&", "&LEFT(B2,IFERROR(FIND(" ",B2,FIND(" ",B2)+1),FIND(" ",B2))-1)

You can then sort on this column.

[ABabeNChrist]

Hi Hans
I’d like to keep the Sales sheet intact as is. I was hoping to sort out all of the current client names from the Sales sheet (Column B Client Name )to a separate sheet, and that were alphabetized with client’s last name, then the next 2 columns will have corresponding date and phone # for that specific client, Column A is Date, Column H is Phone # on the Sales sheet.
The way the Sales sheet works is when a job comes in all client information would be added onto the next available row. So naturally the clients name will be random. The reason for a separate sheet is for a quicker reference in locating client by using last name for contact reasons.

[HansV]

Here is a macro you could use:

Code: Select all

Sub FillContact()
  Dim wshS As Worksheet
  Dim wshC As Worksheet
  Dim r As Long
  Dim m As Long
  Dim strName As String
  Dim p As Long
  Application.ScreenUpdating = False
  Set wshS = Worksheets("Sales")
  Set wshC = Worksheets("Contact")
  wshC.Range("A2:A" & wshC.Rows.Count).EntireRow.ClearContents
  m = wshS.Range("A" & wshS.Rows.Count).End(xlUp).Row
  For r = 2 To m
    strName = wshS.Range("B" & r)
    p = InStrRev(strName, " ")
    strName = Mid(strName, p + 1) & ", " & Left(strName, p - 1)
    wshC.Range("A" & r) = strName
    wshC.Range("B" & r) = wshS.Range("A" & r)
    wshC.Range("C" & r) = wshS.Range("H" & r)
  Next r
  wshC.Range("A1").CurrentRegion.Sort Key1:=wshC.Range("A1"), _
    Header:=xlYes
  Application.ScreenUpdating = True
End Sub

See the attached sample workbook.

Contacts.xlsm

[ABabeNChrist]

Thank you Hans
That is PERFECT