Sorting within an array, or in a combobox

Hello all,
Anybody out there know if there is a way to sort data in an array, or alternately, to sort in a combobox?

Here's the situation...
I have a userform with a combobox. That combobox is being populated by an array, which is storing filenames from a network directory. The code I'm using is below... basically, grabbing filenames from the directory and throwing them into the array. Then when the userform initializes, using that array to populate the combobox.

Private Sub UserForm_Initialize()
'' Copied, and only slightly modified code from LaVolpe:  http://www.vbforums.com/showthread.php?t=547296
Dim sFile As String
sFile = Dir$("\\corp.bloomberg.com\pn-dfs\global data\research-blaw-profiles\Common\Ask Bloomberg\Custom_Tools\DataSets" & "\*.*", vbDirectory Or vbHidden Or vbSystem Or vbReadOnly Or vbArchive)
Do Until sFile = vbNullString
    If sFile <> "." Then ' this directory
       If sFile <> ".." Then ' parent directory
          ' add the file to your array here
       End If
    End If
    sFile = Dir$()
    If sFile <> ".." Then ImportDataSet_Form.ComboBox1.AddItem sFile

Loop


End Sub

So, is there a way to alphabatize the filenames, without first writing them to the sheet?

Thanks for any input!

Hi JP

Look at this link...I've used the code successfully in the past http://www.cpearson.com/excel/SortingArrays.aspx

Hi,

In a standard module

'// ExcelFox.com created on 28-May-2011
Option Base 1
Public FileList()          As String
Public FileCounter         As Long
Public Enum SortType
    Ascending = 1
    Descending = 2
End Enum
Public Function GETFILELIST(ByVal FolderPath As String, ByVal Extn As String, _
                                Optional IncludeSubFolder As Boolean, _
                                Optional ByVal Criteria As String) As String()
    
    Dim FileName    As String
    Dim strExtn     As String
    Dim blnSkipCrit As Boolean
    
    If Right$(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    Extn = LCase$(Replace(Extn, ".", ""))
    FileName = LCase$(Dir(FolderPath & "*." & Extn))
    If Len(Criteria) Then
        Criteria = LCase$(Criteria)
    Else
        blnSkipCrit = True
    End If
    FileCounter = 0
    Do While Len(FileName)
        strExtn = LCase$(Mid$(FileName, InStrRev(FileName, ".") + 1))
        If strExtn Like Extn Then
            If Not blnSkipCrit Then
                If InStr(1, FileName, Criteria) Then
                    FileCounter = FileCounter + 1
                    ReDim Preserve FileList(1 To FileCounter)
                    'FileList(FileCounter) = FolderPath & FileName'file name with full path
                    FileList(FileCounter) = FileName
                End If
            Else
                FileCounter = FileCounter + 1
                ReDim Preserve FileList(1 To FileCounter)
                FileList(FileCounter) = FileName
            End If
        End If
        FileName = LCase$(Dir())
    Loop
    
    If IncludeSubFolder Then
        SubFoldersFilesCount FolderPath, Extn, Criteria
    End If
    
    GETFILELIST = FileList
    
End Function
Private Sub SubFoldersFilesCount(ByVal Folder, ByVal Extn As String, _
                                    Optional ByVal Criteria As String)
    Dim objFSO      As Object
    Dim objFolder   As Object
    Dim strExtn     As String
    Dim blnSkipCrit As Boolean
    
    If objFSO Is Nothing Then
        Set objFSO = CreateObject("Scripting.FileSystemObject")
    End If
    Set Folder = objFSO.GetFolder(Folder)

    For Each SubFolder In Folder.SubFolders
        Set objFolder = objFSO.GetFolder(SubFolder.Path)
        For Each FileName In objFolder.Files
            strExtn = LCase$(Mid$(FileName, InStrRev(FileName, ".") + 1))
            If strExtn Like Extn Then
                If Not blnSkipCrit Then
                    If InStr(1, LCase$(FileName.Name), Criteria) Then
                        FileCounter = FileCounter + 1
                        ReDim Preserve FileList(1 To FileCounter)
                        FileList(FileCounter) = FileName.Name
                    End If
                Else
                    FileCounter = FileCounter + 1
                    ReDim Preserve FileList(1 To FileCounter)
                    FileList(FileCounter) = FileName.Name
                End If
            End If
        Next
        SubFoldersFilesCount SubFolder, Extn, Criteria
    Next
    
End Sub

Function SORT_SDARRAY(ByRef SortData, ByVal SortBy As SortType)
    
    Dim i           As Long
    Dim j           As Long
    Dim UB          As Long
    Dim UB1         As Long
    Dim UB2         As Long
    Dim tmp         As Variant
    Dim SDArr       As Variant
    
    If TypeOf SortData Is Range Then
        If SortData.Rows.Count > 1 And SortData.Columns.Count = 1 Then
            SDArr = Application.Transpose(SortData)
        ElseIf SortData.Rows.Count = 1 And SortData.Columns.Count > 1 Then
            SDArr = Application.Transpose(Application.Transpose(SortData))
        ElseIf SortData.Rows.Count = 1 And SortData.Columns.Count = 1 Then
            SORT_SDARRAY = SortData.Value2
            Exit Function
        Else
            SORT_SDARRAY = CVErr(xlErrNA)
            Exit Function
        End If
    Else
        On Error Resume Next
        UB1 = UBound(SortData, 1)
        UB2 = UBound(SortData, 2)
        On Error GoTo 0
        If UB1 > 1 And UB2 = 1 Then
            SDArr = Application.Transpose(SortData)
        ElseIf UB1 = 1 And UB2 > 1 Then
            SDArr = Application.Transpose(Application.Transpose(SortData))
        ElseIf UB1 = 1 And UB2 = 1 Then
            SORT_SDARRAY = SortData
            Exit Function
        ElseIf UB1 > 0 And (Len(UB2) = 0 Or UB2 = 0) Then
            SDArr = SortData
        Else
            SORT_SDARRAY = CVErr(xlErrNA)
            Exit Function
        End If
    End If
    
    UB = UBound(SDArr)
    
    If SortBy = Ascending Then
        For i = 1 To UB
            For j = i To UB
                If SDArr(j) < SDArr(i) Then
                    tmp = SDArr(i)
                    SDArr(i) = SDArr(j)
                    SDArr(j) = tmp
                End If
            Next
        Next
        SORT_SDARRAY = SDArr
    Else
        For i = 1 To UB
            For j = i To UB
                If SDArr(j) > SDArr(i) Then
                    tmp = SDArr(i)
                    SDArr(i) = SDArr(j)
                    SDArr(j) = tmp
                End If
            Next
        Next
        SORT_SDARRAY = SDArr
    End If
    
End Function

In userform module

Private Sub UserForm_Initialize()
    
    Dim f, sf
    
    f = GETFILELIST("\\corp.bloomberg.com\pn-dfs\global data\research-blaw-profiles\Common\Ask Bloomberg\Custom_Tools\DataSets\", ".xls*", 1, "")
    
    sf = SORT_SDARRAY(f, Ascending)
    
    Me.ComboBox1.List = sf
    
End Sub

HTH

Why not using Excel ?

Private Sub UserForm_Initialize()
  c00= Dir("\\corp.bloomberg.com\pn-dfs\global data\research-blaw-profiles\Common\Ask Bloomberg\Custom_Tools\DataSets\*.?*")

  Do Until c00=""
    c01=c01 & "|" & c00
    c00=dir
  Loop
  sn=split(mid(c01,2),"|")

  with sheets(1)
    .cells(1,200).resize(ubound(sn)+1)=application.transpose(sn)
    with .columns(200)
      .sort sheets(1).cells(1,200)
      combobox1.list=.specialcells(2).value
      .clearcontents
    end with
  end with
End Sub

One more alternative:

Sub demo()
    Sheet1.ComboBox1.List = Range("A2:A11").Value
    SortTheBox Sheet1.ComboBox1
    
    Sheet1.ListBox1.List = Range("B2:B11").Value
    SortTheBox Sheet1.ListBox1
End Sub

Function SortTheBox(vCtl As Variant) As Boolean
    Dim i         As Long
    Dim j         As Long

    If Not IsObject(vCtl) Then Exit Function

    Select Case TypeName(vCtl)
        Case "ComboBox", "ListBox"
            With vCtl
                For i = 1 To .ListCount - 1
                    For j = 0 To i - 1
                        If .List(i) < .List(j) Then
                            .AddItem .List(i), j
                            .RemoveItem i + 1
                            Exit For
                        End If
                    Next j
                Next i
            End With

            SortTheBox = True
    End Select
End Function