Option Explicit

 Private Const delim As String = "."
Private Const basis As Double = 10000
Private Const logbasis As Long = 4

'--- http://google.com/groups?threadm=%23Bq7SPihDHA.3276%40tk2msftngp13.phx.gbl

Public Function stufnr2zahl(stufnr As String) As Double

' stufnr2zahl wandelt den String stufnr in eine Double Zahl um.
' Beispiel: Bei gegebenem Trennzeichen "." und Basis 100 ist stufnr2zahl("4.33.12.1") = 4,331201
' Mit dieser Hilfe kann nach den gegebenen Strings hierarchisch sortiert werden.

Dim strtmp As String    ' Hilfsvariable zur Untersuchung von stufnr
Dim delimlen As Long ' Zur Ermittlung der Zahl rechts hinter dem jeweils letzten Trennzeichen

stufnr2zahl = 0
strtmp = Trim(stufnr)   ' Leerzeichen links und rechts weg

loop1:

' Wir gehen von rechts nach links durch stufnr durch und schieben die erkannten Teilzahlen versetzt ins Ergebnis

delimlen = InStr(1, strReverse(strtmp), delim, vbTextCompare) ' Position des Trennzeichens von rechts gesehen?

If delimlen > 0 Then ' Trennzeichen gefunden

    stufnr2zahl = stufnr2zahl / basis + Right(strtmp, delimlen - 1) ' Rechte Teilzahl ins Ergebnis nehmen
    strtmp = Left(strtmp, Len(strtmp) - delimlen) ' Rechte Teilzahl herausnehmen
    GoTo loop1 ' Weiter untersuchen

End If

stufnr2zahl = stufnr2zahl / basis + strtmp ' Restzahl ins Ergebnis nehmen

End Function

Public Function stufnr2normstr(stufnr As String) As String

' stufnr2normstr wandelt den String stufnr in einen String mit normierten Hierarchiestufen um.
' Beispiel: Bei gegebenem Trennzeichen "." und logbasis 2 ist stufnr2normstr("4.33.12.1") = "04331201"
' Mit dieser Hilfe kann nach den gegebenen Strings hierarchisch sortiert werden.

Dim strtmp As String    ' Hilfsvariable zur Untersuchung von stufnr
Dim delimlen As Long ' Zur Ermittlung der Zahl rechts hinter dem jeweils letzten Trennzeichen

stufnr2normstr = ""
strtmp = Trim(stufnr)   ' Leerzeichen links und rechts weg



' Wir gehen von rechts nach links durch stufnr durch und schieben die erkannten Teilzahlen versetzt ins Ergebnis

delimlen = InStr(1, strReverse(strtmp), delim, vbTextCompare) ' Position des Trennzeichens von rechts gesehen?

Do While delimlen > 0 ' Trennzeichen gefunden = _
   stufnr2normstr = Format(Right(strtmp, delimlen - 1), _
   String(logbasis, "0")) & stufnr2normstr ' Rechte Teilzahl ins Ergebnis nehmen
    strtmp = Left(strtmp, Len(strtmp) - delimlen) ' Rechte Teilzahl herausnehmen
    delimlen = InStr(1, strReverse(strtmp), _
      delim, vbTextCompare) ' Position _
      des Trennzeichens von rechts gesehen?

Loop

stufnr2normstr = Format(strtmp, _
  String(logbasis, "0")) & stufnr2normstr ' _
  Restzahl ins Ergebnis nehmen

End Function

'================= my own original stuff continues here===
'posted but not documented
Sub Sort_2nd_Name_in_Column_A() '2003-08-30 posted / not documented
    Dim cell As Range, i As Long, var As String, xlong As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Columns("A:A").Insert Shift:=xlToRight
    For Each cell In Columns("B").SpecialCells(xlConstants, xlTextValues)
       var = Trim(cell.Value)
       i = InStr(1, var, " ")
       If i > 1 Then
          cell.Offset(0, -1) = "'" & Mid(var, i + 1)
        Else
           cell.Offset(0, -1) = var
       End If
   Next cell
   Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, _
      Key2:=Range("B2"), Order2:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   Columns("A").Delete
   xlong = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Columns.Count 'Tip73
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub

Sub sortEachRow()
 'based on Tom Ogilvy, 2001-03-24, Programming
 Dim rw As Range
 If Selection.Columns.Count = 1 Then
   MsgBox "your selection must involve more than one cell  or column"
   Exit Sub
 End If
 For Each rw In Selection.Rows
    rw.Sort Key1:=rw, Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
 Next
 End Sub

 Sub sortEachColumn()
 'Tom Ogilvy, 2001-03-24, Programming
 Dim col As Range
 For Each col In Range("a2:g100").Columns
    col.Sort Key1:=col, Order1:=xlAscending
 Next
 End Sub
 Sub SortAscending_NoHeader()
    Cells.Sort Key1:=ActiveCell, _
    Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom
End Sub
Sub SortAscending_Header()
    Cells.Sort Key1:=ActiveCell, _
    Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom
End Sub