Go Back   Access World Forums > Microsoft Access Reference > Access FAQs

 
Closed Thread
 
Thread Tools Rate Thread Display Modes
Old 06-20-2010, 04:28 PM   #1
ajetrumpet
Banned
 
Join Date: Jun 2007
Location: Universe - Local Group - Milky Way Galaxy - Orion Arm
Posts: 5,640
Thanks: 0
Thanked 97 Times in 44 Posts
ajetrumpet has a spectacular aura about ajetrumpet has a spectacular aura about
Send a message via MSN to ajetrumpet Send a message via Yahoo to ajetrumpet
Sort Array VBA

These code snippets sort values in the following order: NULLS (must be converted to 0-length strings), special characters (in numerical order from CHR() chart), numbers, upper case, lower case

Here's the code to sort a one-dimensional array:

Code:
Function SortArray(ArrayToSort() As Variant) As Variant
     
    Dim First           As Integer
    Dim Last            As Integer
    Dim i               As Integer
    Dim j               As Integer
    Dim Temp            As String
     
    First = LBound(ArrayToSort)
    Last = UBound(ArrayToSort)
    For i = First To Last - 1
        For j = i + 1 To Last
            If ArrayToSort(i) > ArrayToSort(j) Then
                Temp = ArrayToSort(j)
                ArrayToSort(j) = ArrayToSort(i)
                ArrayToSort(i) = Temp
            End If
        Next j
    Next i
    
        For i = 1 To UBound(ArrayToSort)
            Debug.Print ArrayToSort(i)
        Next i

End Function
If you want to sort an array with 2 dimensions, it's just like sorting rows of data on an excel sheet based on ONE column only (e.g. - sorting a table based on a column). For example, number of columns would be the 1st dimension and the number of rows would be the 2nd. Here's an example of sorting a table this way (this can adapted to work in Excel too):

Code:
Function GetTableArray()

Dim i As Long
Dim rows As Long
Dim cols As Long

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("TABLE", dbOpenDynaset)
    
    rs.MoveLast
    rs.MoveFirst

rows = rs.RecordCount
cols = rs.Fields.Count - 1

    Dim myarray() As Variant
    
        'RESIZE ARRAY TO TABLE SPECS
        Do Until rs.EOF
            For i = 0 To cols
                ReDim myarray(i + 1, rs.AbsolutePosition + 1)
            Next i
                rs.MoveNext
        Loop
        
                rs.MoveFirst

        'POPULATE ARRAY WITH TABLE DATA
        Do Until rs.EOF
            For i = 0 To cols
                myarray(i, rs.AbsolutePosition) = IIf(IsNull(rs.Fields(i)), "", rs.Fields(i))
            Next i
                rs.MoveNext
        Loop

rs.Close
Set rs = Nothing

        Call SortArray(myarray, COLUMN NUMBER TO SORT)
    
End Function



Function SortArray(ArrayToSort() As Variant, SortCol As Integer) As Variant

On Error Resume Next

    Dim First           As Integer
    Dim Last            As Integer
    Dim i               As Integer
    Dim j               As Integer
    Dim k               As Integer
    Dim Temp            As String
    Dim prev            As String
    Dim s               As String
    Dim origarray()     As Variant
    Dim rowarray()      As Variant

origarray = ArrayToSort()
SortCol = SortCol - 1
k = 0

    First = LBound(ArrayToSort, 2)
    Last = UBound(ArrayToSort, 2)
    
    'SORT THE COLUMN VALUES HERE
    For i = First To Last - 1
        For j = i + 1 To Last
            If ArrayToSort(SortCol, i) > ArrayToSort(SortCol, j) Then
                Temp = ArrayToSort(SortCol, j)
                ArrayToSort(SortCol, j) = ArrayToSort(SortCol, i)
                ArrayToSort(SortCol, i) = Temp
            End If
        Next j
    Next i
    
    'USE SORTED COLUMN VALUES TO STORE RELATED ROW NUMBERS IN A NEW ARRAY
    For i = 1 To UBound(ArrayToSort, 2)
        If IIf(ArrayToSort(SortCol, i) = "", "NULL", ArrayToSort(SortCol, i)) <> prev Then
            For j = 0 To UBound(origarray, 2) - 1
                If IIf(origarray(SortCol, j) = "", "NULL", origarray(SortCol, j)) = _
                   IIf(ArrayToSort(SortCol, i) = "", "NULL", ArrayToSort(SortCol, i)) Then
                    ReDim Preserve rowarray(k)
                    rowarray(k) = j
                    k = k + 1
                End If
            Next j
        End If
                        prev = IIf(ArrayToSort(SortCol, i) = "", "NULL", ArrayToSort(SortCol, i))
    Next i

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("TABLE", dbOpenDynaset)
    
    rs.MoveLast
    rs.MoveFirst

    'REPOPULATE TABLE WITH SORTED DATA
    Do Until rs.EOF

        For i = 0 To UBound(origarray, 2)
            For j = 0 To UBound(origarray, 1)
                rs.Edit
                rs.Fields(j) = origarray(j, rowarray(i))
                rs.Update
            Next j
                rs.MoveNext
        Next i
    
    Loop

rs.Close
Set rs = Nothing

End Function

ajetrumpet is offline  
The Following 2 Users Say Thank You to ajetrumpet For This Useful Post:
hassanogaibi (06-28-2016), mdnuts (07-28-2015)
Closed Thread

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Navigate Internet Explorer using VBA ajetrumpet Access FAQs 4 08-11-2010 09:00 AM
Using Excel VBA to process XML web query response Bilbo_Baggins_Esq Excel 1 03-23-2008 06:27 PM
Using VBA to process web response.xml Bilbo_Baggins_Esq Modules & VBA 4 03-23-2008 06:22 PM
Formatting Error with VBA Array? M_S_Jones Modules & VBA 3 03-07-2008 05:55 AM
vba reading from excel yoritomo Modules & VBA 6 10-05-2005 02:32 AM




All times are GMT -8. The time now is 06:20 AM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post


Sponsored Links


Powered by vBulletin®
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World