Sorting into Alphaebeticla orde

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
 
C

Chip Pearson

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
 
C

Cecilkumara Fernando

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
 
G

Gord Dibben

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
 
Top