Sort multidimensional array

[SBsteven]

I need help sorting a 2D multidimensional array.

I have searched Google and tried several pieces of code out there, but none seem to work.

Any help would be greatly appreciated!!

SBsteven

[Saket]

Can you paste whatever you have tried so far?

[SBsteven]

==========================================================

Code:

'Alphabetically sort the arrARFund array
Function DataListSort(arrARFund ,strSort)
'Input: arrARFund = Array of data items, strings or integers'Input: strSort = Sort method.
'Options: ASC (ascending) or DESC (descending)
'Output: Sorted Array
'Notes: This is currently only storing the first 10 characters.
'Change MaxCharacters to increase this limit to allow more precise sorting.
'This will also increase memory usage.
DataListSort = ""
strList = ""
strSort = Trim(UCase(strSort))
If Not strSort = "ASC" And Not strSort = "DESC" Then
strSort = "ASC"
End If
Const adVarChar = 1000 ' Set the data type to variant.
Const MaxCharacters = 20 ' Set the max num of characters to store
'Setup Data object and connection
Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append "Items", adVarChar, MaxCharacters
DataList.Open
'Iterate through to add the array items to the record set
For Each item In arrARFund
DataList.AddNew
DataList("Items") = item
DataList.Update
Next
'Sort the record set
DataList.Sort = "Items" & " " & strSort
DataList.MoveFirst
DataListSort = DataList.GetRows()
DataList.Close
End Function

==========================================================

==========================================================

Code:

function SortArray(arrARFund (),lnCol,lcType)
Dim lnCnti
Dim lnCntj
Dim lnSmallest_Value
Dim lnSmallest_J
Dim lnMin
Dim lnMax
Dim lcTemp

lnMin = lbound(arrARFund ,2)
lnMax = ubound(arrARFund ,2)
For lnCnti = lnMin To lnMax - 1
lnSmallest_Value = arrARFund (lnCol,lnCnti)
lnSmallest_J = lnCnti
For lnCntj = lnCnti + 1 To lnMax
if lcType = "" Then
' See if arrARFund (lnCntj) is smaller. changed To strComp to work With strings.
if strComp(arrARFund (lnCol,lnCntj),lnSmallest_Value,vbTextCompare) = -1 Then
' Save the new smallest value.
lnSmallest_Value = arrARFund (lnCol,lnCntj)
lnSmallest_J = lnCntj
End if
End if
if lcType = "date" Then
' See if arrARFund (lnCntj) is smaller. changed To Japan Dates to work With Dates.
lcstr1 = Replace(ConvertShortDate(arrARFund (lnCol,lnCntj)),"/","")
lcstr2 = Replace(ConvertShortDate(lnSmallest_Value),"/","")
lcback1 = Mid(lcstr1,5,4) & Mid(lcstr1,3,2) & Mid(lcstr1,1,2)
lcback2 = Mid(lcstr2,5,4) & Mid(lcstr2,3,2) & Mid(lcstr2,1,2)
if lcback1 < lcback2 Then
' Save the new smallest value.
lnSmallest_Value = arrARFund (lnCol,lnCntj)
lnSmallest_J = lnCntj
End if
End if
Next 'lnCntj
if lnSmallest_J <> lnCnti Then
' Swap items lnCnti and lnSmallest_J.
For intA = 0 To ubound(arrARFund ,1)
lcTemp = arrARFund (intA,lnSmallest_J)
arrARFund (intA,lnSmallest_J) = arrARFund (intA,lnCnti)
arrARFund (intA,lnCnti) = lcTemp
Next 'intA
End if
Next 'lnCnti
SortArray = arrARFund
End function

==========================================================

Code:

' sort a multi dem array
' modified to allow different cols to be the key for the sort.
' modified to sort dates properly
' modified to allow you to specify a sort direction 'a' or 'd'
' Fixed issue with not finding a column with data in it to identify the type.
' Fixed issue when tring to sort numbers.
' Fixed issue when sometimes it didn't compare the number properly.  Casted to cdbl
' Useage arraysort(array to be sorted, column to sort on, direction to sort (a|d)
' By: Eric Repec
' InetSolution Inc
' http://www.inetsolution.com
function arraysort(arrARFund (),intSortCol,strDirection)
Dim i
Dim j
Dim value
Dim value_j
dim min
dim max
dim temp
dim datatype
dim intComp
dim intA
dim intCheckIndex
  
min = lbound(arrARFund ,2)
max = ubound(arrARFund ,2)
  
' check to see what direction you want to sort.
if lcase(strDirection) = "d" then
    intComp = -1
else
    intComp = 1
end if
  
if intSortCol < 0 or intSortCol > ubound(arrARFund ,1) then
    arraysort = arrARFund
    exit function
end if

' find the first item which has valid data in it to sort
intCheckIndex = min
while len(trim(arrARFund (intSortCol,intCheckIndex))) = 0 and intCheckIndex < ubound(arrARFund ,2)
    intCheckIndex = intCheckIndex + 1
wend
if isDate(trim(arrARFund (intSortCol,intCheckIndex))) then
    datatype = 1
else
    if isNumeric(trim(arrARFund (intSortCol,intCheckIndex))) then
        datatype = 2
    else
        datatype = 0
    end if
end if
For i = min To max - 1
    value = arrARFund (intSortCol,i)
    value_j = i
    For j = i + 1 To max
        select case datatype
            case 0
                ' See if arrARFund (j) is smaller. works with strings now.
                If strComp(arrARFund (intSortCol,j),value,vbTextCompare) = intComp Then
                    ' Save the new smallest value.
                    value = arrARFund (intSortCol,j)
                    value_j = j
                End If
            case 1
                if intComp = -1 then
                    if DateDiff("s",arrARFund (intSortCol,j),value) > 0 then
                        ' Save the new smallest value.
                        value = arrARFund (intSortCol,j)
                        value_j = j
                    end if
                else
                    if DateDiff("s",arrARFund (intSortCol,j),value) < 0 then
                        ' Save the new smallest value.
                        value = arrARFund (intSortCol,j)
                        value_j = j
                    end if
                end if
            case 2
                if intComp = -1 then
                    if cdbl(arrARFund (intSortCol,j)) < cdbl(value) then
                        ' Save the new smallest value.
                        value = arrARFund (intSortCol,j)
                        value_j = j
                    end if
                else
                    if cdbl(arrARFund (intSortCol,j)) > cdbl(value) then
                        ' Save the new smallest value.
                        value = arrARFund (intSortCol,j)
                        value_j = j
                    end if
                end if
        end select
    Next 'j
    If value_j <> i Then
        ' Swap items i and value_j.
        for intA = 0 to ubound(arrARFund ,1)
            temp = arrARFund (intA,value_j)
            arrARFund (intA,value_j) = arrARFund (intA,i)
            arrARFund (intA,i) = temp
        next 'intA
    End If
Next 'i
arraysort = arrARFund
End function

[Saket]

I will go through these functions,
meanwhile can you refer https://www.learnqtp.com/dotnetfactory-q...arraylist/
let me know if that helps.

[anuj.bajaj]

Below is the piece of code for sorting two dimensional array in vbscript. Try to execute it & should there be any concern, please let me know.

Cheers,
AB

Code:

Dim Myarr(2,2)
Myarr(0,0) = 0
Myarr(0,1) = 6
Myarr(0,2) = 5
Myarr(1,0) = 1
Myarr(1,1) = 4
Myarr(1,2) = 3
Myarr(2,0) = 2
Myarr(2,1) = 8
Myarr(2,2) = 7

Call sortArray()

Function sortArray()
    For row = 0 to UBound(Myarr, 1)
        For col = 0 To UBound(Myarr, 2)
            While Not (setRightDimension(row, col, Myarr(row, col)))
                setRightDimension row, col, Myarr(row, col)
            Wend
        Next
    Next
    Msgbox "Sorting Completed!!!"
    For i = 0 to UBound(Myarr, 1)
        For j = 0 To UBound(Myarr, 2)
            Print Myarr(i, j)
        Next
    Next
End Function


Function setRightDimension(ByVal rowNum, ByVal colNum, ByVal value1)
    Dim originalColNumber:originalColNumber = colNum
    Dim correctRow:correctRow = rowNum
    Dim correctCol:correctCol = colNum
    For rowNumber = rowNum to UBound(Myarr, 1)
        For colNumber = colNum To UBound(Myarr, 2) Step 1
            If value1 > Myarr(rowNumber, colNumber) Then
                correctRow = rowNumber
                correctCol = colNumber
            End If
        Next
        If colNumber = UBound(Myarr, 2) + 1 Then
            colNum = 0
        End If
    Next
    If rowNum <> correctRow or originalColNumber <> correctCol Then
        swap rowNum, originalColNumber, correctRow, correctCol
        setRightDimension = False
    Else
        setRightDimension = True
    End If
End Function

Function swap(ByVal oldRow, ByVal oldCol, ByVal newRow, ByVal newCol)
    Dim temp:temp = Myarr(oldRow, oldCol)
    Myarr(oldRow, oldCol) = Myarr(newRow, newCol)
    Myarr(newRow, newCol) = temp
End Function

[venkatesh9032]

Hello anuj you code gives me output it looks like.....complex...can u shortend that one...

[anuj.bajaj]

Hi Venkatesh,

I tried to make it less complex that I could. If you execute the program in debug mode & check the flow, it is checking the number at each index & placing it at correct row & column.

Cheers,
AB

[venkatesh9032]

Thats'''very nice anuj....


I have a alternative way for clear view of understanding...

Please store the two dimensional array elements into single dimensional array by using redim preserve..

Sort that single dimensional array..

Pass that single dimensionla array to two dimensional array It will done with clear understanding...

[anuj.bajaj]

There are lot of ways of implementing any given logic. It is what clicked your mind at the very right moment & you are able to implement is successfully

Can you please show any code snippet of implementing it using your way?

Cheers,
AB