Public Sub AlphaSortComponents()

    Dim odoc As AssemblyDocument
    Set odoc = ThisApplication.ActiveDocument
    
    Dim odef As AssemblyComponentDefinition
    Set odef = odoc.ComponentDefinition
    
    Dim strOccs() As String
    ReDim strOccs(odef.Occurrences.Count + odef.OccurrencePatterns.Count - 1)
    
    ' Get names of all occurrences in the assembly.
    Dim i As Long
    For i = 1 To odef.Occurrences.Count
        strOccs(i - 1) = odef.Occurrences(i).Name
    Next
    
    i = i - 1
    
    ' Get names of all occurrence patterns in the assembly.
    If odef.OccurrencePatterns.Count > 0 Then
        For i = odef.Occurrences.Count + 1 To odef.Occurrences.Count + odef.OccurrencePatterns.Count
            strOccs(i - 1) = odef.OccurrencePatterns(i - odef.Occurrences.Count).Name
        Next
        i = i - 1
    End If
    
    ' Sort the names alphabetically.
    QuickSort strOccs, LBound(strOccs), UBound(strOccs)
    
    On Error Resume Next
    Dim oTransaction As Transaction
    Set oTransaction = ThisApplication.TransactionManager.StartTransaction(odoc, "Sort Components")
    
    ' Get the "model" browser pane
    Dim oPane As BrowserPane
    Set oPane = odoc.BrowserPanes.Item("AmBrowserArrangement")
    
    Dim oPreviousOcc As Object
    Set oPreviousOcc = Nothing
    
    Dim j As Long
    For j = 1 To i
    
        Dim oThisOcc As Object
        Set oThisOcc = Nothing
        Set oThisOcc = odef.Occurrences.ItemByName(strOccs(j - 1))
        
        If oThisOcc Is Nothing Then
            Err.Clear
            Set oThisOcc = odef.OccurrencePatterns.Item(strOccs(j - 1))
        End If
        
        'Ignore pattern elements
        If Not (TypeOf oThisOcc Is ComponentOccurrence And Not oThisOcc.PatternElement Is Nothing) Then
            
            Err.Clear
            Dim oThisNodeDef As BrowserNodeDefinition
            Set oThisNodeDef = odoc.BrowserPanes.GetNativeBrowserNodeDefinition(oThisOcc)
                
            Dim oThisBrowserNode As BrowserNode
            Set oThisBrowserNode = oPane.TopNode.AllReferencedNodes(oThisNodeDef).Item(1)
                
            If Not oPreviousOcc Is Nothing Then
                            
                Dim oPreviousNodeDef As BrowserNodeDefinition
                Set oPreviousNodeDef = odoc.BrowserPanes.GetNativeBrowserNodeDefinition(oPreviousOcc)
                
                Dim oPreviousBrowserNode As BrowserNode
                Set oPreviousBrowserNode = oPane.TopNode.AllReferencedNodes(oPreviousNodeDef).Item(1)
                
                Call oPane.Reorder(oPreviousBrowserNode, False, oThisBrowserNode)
                                
                If Err.Number Then
                    oTransaction.Abort
                    MsgBox "Sorting failed.", vbExclamation
                    Exit Sub
                End If
            Else
                'Move the first node below origin folder
                Dim oFirstBrowserNode As BrowserNode
                Dim oTempNode As BrowserNode
    
                For Each oTempNode In oPane.TopNode.BrowserNodes
                
                    Dim oNativeObject As Object
                    Set oNativeObject = oTempNode.BrowserNodeDefinition.NativeObject
            
                    If Not oNativeObject Is Nothing Then
                        If TypeOf oNativeObject Is ComponentOccurrence Or _
                           TypeOf oNativeObject Is OccurrencePattern Then
                           
                            Set oFirstBrowserNode = oTempNode
                            Exit For
                            
                        End If
                    End If
                    
                 Next
                 
                Call oPane.Reorder(oFirstBrowserNode, True, oThisBrowserNode)
                                
                Err.Clear
            End If
                
            Set oPreviousOcc = oThisOcc
            
        End If
        
    Next
    
    oTransaction.End
    
End Sub


Private Sub QuickSort(strArray() As String, intBottom As Integer, intTop As Integer)

  Dim strPivot As String, strTemp As String
  Dim intBottomTemp As Integer, intTopTemp As Integer

  intBottomTemp = intBottom
  intTopTemp = intTop

  strPivot = strArray((intBottom + intTop) \ 2)

  While (intBottomTemp <= intTopTemp)
    
    While (UCase$(strArray(intBottomTemp)) < UCase$(strPivot) And intBottomTemp < intTop)
      intBottomTemp = intBottomTemp + 1
    Wend
    
    While (UCase$(strPivot) < UCase$(strArray(intTopTemp)) And intTopTemp > intBottom)
      intTopTemp = intTopTemp - 1
    Wend
    
    If intBottomTemp < intTopTemp Then
      strTemp = strArray(intBottomTemp)
      strArray(intBottomTemp) = strArray(intTopTemp)
      strArray(intTopTemp) = strTemp
    End If
    
    If intBottomTemp <= intTopTemp Then
      intBottomTemp = intBottomTemp + 1
      intTopTemp = intTopTemp - 1
    End If
  
  Wend

  'the function calls itself until everything is in good order
  If (intBottom < intTopTemp) Then QuickSort strArray, intBottom, intTopTemp
  If (intBottomTemp < intTop) Then QuickSort strArray, intBottomTemp, intTop

End Sub