Sorting into Alphaebeticla orde

  • Thread starter Thread starter Mark
  • Start date Start date
M

Mark

I am using Excel 97 and I have a list of surnames in
Column A of a spreadsheet.

What I am trying to achieve is to sort them into order but
place A Capital letter in the row immediatley above when
the lfirst letter changes

For example:-

A
ADAMS
ARTHURS
ABBOTT
B
BRIGGS
BAMFORTH
BENTLEY
C
CHILDS
COLDWELL

through to Z

What I also need in the routine is an error check so that
if a letter of the alphabet does not exist it moves down
to the next letter


Can anyone assist me with some code to do this please?


Mark
 
Mark,

Assuming your data is in column A, sort the data in the normal
manner from the Data menu, and then run the following code:

Dim LastRow As Long
Dim RowNdx As Long
Dim R1 As Range
Dim R2 As Range
Const FIRSTROW = 2
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

For RowNdx = LastRow To FIRSTROW + 1 Step -1
Set R1 = Cells(RowNdx, "A")
Set R2 = Cells(RowNdx - 1, "A")
If Left(R1.Text, 1) <> Left(R2.Text, 1) Then
Rows(RowNdx).Insert
Rows(RowNdx).Cells(1, 1).Value = UCase(Left(R1.Text, 1))
End If
Next RowNdx
Rows(FIRSTROW).Insert
Cells(FIRSTROW, "A").Value = UCase(Left(Cells(FIRSTROW + 1,
"A").Text, 1))


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
 
Mark
At the end of the list of surnames type A to Z and sort the list including
the letters.
don't like typing so much then put the formula
=Char(Row(A1)+64) fill down 26 rows and select the range
copy, then pastespecial values
HTH
Cecil
 
Mark

Assumes you have a title row in A1

Sub rowchange()

Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Columns("A:A").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

FirstRow = 2
LastRow = Cells(Rows.Count, "a").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
If Left(Cells(iRow, "a").Value, 1) <> _
Left(Cells(iRow - 1, "a").Value, 1) Then
Rows(iRow).Insert
With Cells(iRow, "a")
.Value = Left(Cells(iRow + 1, "a").Value, 1)
.Font.Bold = True
.HorizontalAlignment = xlCenterAcrossSelection
.Font.Underline = xlUnderlineStyleSingle
End With
End If
Next
End Sub

Gord Dibben Excel MVP
 
Back
Top