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