'See http://www.mvps.org/dmcritchie/excel/sorttcp.htm -- David McRitchie 
'Functions: IPSort, IPNorm,
'Subroutines: IPSortSUB, IPNormSUB, IP2Text for European usage
'Reformat TCP/IP address for sorting

Function IPSort(cell)
     oldvalue = cell.Value
     p1 = 0
     p2 = 0
     p3 = 0
     For px = 2 To Len(oldvalue)
        If Mid(oldvalue, px, 1) = "." Then
            If p1 = 0 Then
               p1 = px
               ElseIf p2 = 0 Then p2 = px
               ElseIf p3 = 0 Then p3 = px
            End If
        End If
     Next px
     IPSort = Right("00000" & Mid(oldvalue, 1, p1 - 1), 3) _
        & "." & Right("00000" & Mid(oldvalue, p1 + 1, p2 - p1 - 1), 3) _
        & "." & Right("00000" & Mid(oldvalue, p2 + 1, p3 - p2 - 1), 3) _
        & "." & Right("00000" & Mid(oldvalue, p3 + 1), 3)
End Function

Function IPNorm(cell)
     oldvalue = cell.Value
     p1 = 0
     p2 = 0
     p3 = 0
     For px = 2 To Len(oldvalue)
        If Mid(oldvalue, px, 1) = "." Then
            If p1 = 0 Then
               p1 = px
               ElseIf p2 = 0 Then p2 = px
               ElseIf p3 = 0 Then p3 = px
            End If
        End If
     Next px
     i1 = Mid(oldvalue, 1, p1 - 1) + 0
     i2 = Mid(oldvalue, p1 + 1, p2 - p1 - 1) + 0
     i3 = Mid(oldvalue, p2 + 1, p3 - p2 - 1) + 0
     i4 = Mid(oldvalue, p3 + 1, Len(oldvalue) - p3) + 0
     IPNorm = i1 & "." & i2 & "." & i3 & "." & i4
End Function

Sub IPSortSUB()
   tCells = Selection.Count
  For ix = 1 To tCells   '(0,0) below is same as (False, False)
     'Selection.Item(iX) = "'" & Selection.Item(iX).AddressLocal(0, 0)  Next iX
     oldvalue = Selection.Item(ix)
     p1 = 0
     p2 = 0
     p3 = 0
     For px = 2 To Len(oldvalue)
        If Mid(oldvalue, px, 1) = "." Then
            If p1 = 0 Then
               p1 = px
               ElseIf p2 = 0 Then p2 = px
               ElseIf p3 = 0 Then p3 = px
            End If
        End If
     Next px
     Selection.Item(ix).Value = Right("00000" & Mid(oldvalue, 1, p1 - 1), 3) _
        & "." & Right("00000" & Mid(oldvalue, p1 + 1, p2 - p1 - 1), 3) _
        & "." & Right("00000" & Mid(oldvalue, p2 + 1, p3 - p2 - 1), 3) _
        & "." & Right("00000" & Mid(oldvalue, p3 + 1), 3)
   Next ix
End Sub

Sub IPNormSUB()
   ' Example of use:
   '   =hyperlink("telnet://" & ipnormsub(b1),ipnormsub(b1))
   tCells = Selection.Count
  For ix = 1 To tCells
     oldvalue = Selection.Item(ix)
     p1 = 0
     p2 = 0
     p3 = 0
     For px = 2 To Len(oldvalue)
        If Mid(oldvalue, px, 1) = "." Then
            If p1 = 0 Then
               p1 = px
               ElseIf p2 = 0 Then p2 = px
               ElseIf p3 = 0 Then p3 = px
            End If
        End If
     Next px
     i1 = Mid(oldvalue, 1, p1 - 1) + 0
     i2 = Mid(oldvalue, p1 + 1, p2 - p1 - 1) + 0
     i3 = Mid(oldvalue, p2 + 1, p3 - p2 - 1) + 0
     i4 = Mid(oldvalue, p3 + 1, Len(oldvalue) - p3) + 0
     Selection.Item(ix).Value = i1 & "." & i2 & "." & i3 & "." & i4
   Next ix
End Sub

Sub IP2text()
'DMcRitchie@hotmail.com Jun 2, 1999 excel.programming
'only of use with European Number formatting"
Dim TheCell As Range
Application.ScreenUpdating = False
For Each TheCell In Selection
    With TheCell
       If .HasFormula = False Then
         'If IsNumeric(.Value) Then  -- replaced with
         If Application.IsNumber(.Value) Then
             ccc = Format(.Value, "###,###,###,###")
             .Value = ""
            .NumberFormat = "@"
             .Value = ccc
         End If
       .NumberFormat = "@"
       End If
    End With
Next TheCell
Application.ScreenUpdating = True
End Sub

Function ALPHA_N(strr As String, lenn As Long) As String
  'ALPHA_N, create length N, alpha on left, numeric on right, fill middle zeros
  'David McRitchie, 1999-01-28
  Application.Calculation = xlCalculationManual    'in XL97
  Application.ScreenUpdating = False
  Dim k As Long
  ALPHA_N = strr
  For k = 1 To Len(strr)
    If Mid(strr, k, 1) <= "9" Then
      ALPHA_N = Left(strr, k - 1) & _
        Left("000000000000000", lenn - Len(strr)) & Mid(strr, k, 99)
      GoTo done
    End If
  Next k
done:
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic  'in XL97
End Function