I'm not sure if this will do what you want. But, try this one. This
macro adds auxiliary column with a header, _Number_, for recovering
original order. I'm using Excel 2003.

Sub TestMacro()
Dim startrow As Long, lstrow As Long, auxcol As Long
Dim i As Long, k As Long, l As Long
Dim TarFst As Range, TarA As Range, rng As Range

Application.ScreenUpdating = False
startrow = 1
lstrow = startrow
Do While (Cells(lstrow, "A") < "")
lstrow = lstrow + 1
Loop
lstrow = lstrow - 1

auxcol = Cells(startrow, Columns.Count).End(xlToLeft).Column

If Cells(startrow, auxcol) = "_Number_" Then
If Application.Max(Columns(auxcol)) < lstrow Then
MsgBox "New data is added. First, show all data, and" _
& " sort by _Number_" & Chr(10) _
& "Second, clear all data in _Number_" _
& Chr(10) & "Then, start again"
Exit Sub
End If
Else
auxcol = auxcol + 1
Cells(startrow, auxcol) = "_Number_"
For i = startrow + 1 To lstrow
Cells(i, auxcol) = i
Next
End If

Set TarFst = Range(Cells(startrow, "A"), Cells(lstrow, "A"))

k = 1
l = 1

For Each rng In TarFst.SpecialCells(xlCellTypeVisible)

Select Case rng.Value

Case 0
rng = "0," & rng.Value
Case 1
rng.Value = k & "," & rng.Value
k = k + 1
Case 2
rng.Value = l & "," & rng.Value
l = l + 1
Case Else
rng.Value = "a," & rng.Value
End Select
Next

Set TarA = Range(Cells(startrow, "A"), Cells(lstrow, auxcol))

TarA.Sort Key1:=Cells(startrow, "A"), Order1:=xlAscending, _
Header:=xlYes

On Error Resume Next

For Each rng In TarFst.SpecialCells(xlCellTypeVisible)
rng = Split(rng.Value, ",")(1)
Next

End Sub

Keiji

HOLLY wrote:
I attempted the 2007 custom sort function but I am working on a spreadsheet
with over 5000 rows. Does this mean I have to create a custom sort with 5000
entries? I am confused. The other aspect to this is I have header rows,
actually have 3 rows of header data...which may affect how this function
works. I think code is the answer....please help!