Trying to sort strings in two-dimensional array VBA

[fat-tony]

Hi Guys,

I have been trying to sort a two-dimensional array in excel using VBA.
the values of the array are all strings not numbers, which has been causing my head to explode.

I have an excel sheet that contains data 4 rows by 4 columns.
I then want to put that data in to an array so I can use it.

This is the first time I have been playing with 2D Arrays in VBA. From what I gathered this is how it should look:

    Dim MyArray(1 To 4, 1 To 4)
    MyArray(1, 1) = "A col1 row1"
    MyArray(1, 2) = "C col1  row2"
    MyArray(1, 3) = "D col1  row3"
    MyArray(1, 4) = "B col1  row4"
    MyArray(2, 1) = "D col2  row1 - sort this col"
    MyArray(2, 2) = "B col2   row2 - sort this col"
    MyArray(2, 3) = "A col2   row3 - sort this col"
    MyArray(2, 4) = "C col2   row4 - sort this col"
    MyArray(3, 1) = "A col3  row1"
    MyArray(3, 2) = "D col3 row2"
    MyArray(3, 3) = "B col3 row3"
    MyArray(3, 4) = "C col3 row4"
    MyArray(4, 1) = "D col4 row1"
    MyArray(4, 2) = "C col4 row2"
    MyArray(4, 3) = "B col4 row3"
    MyArray(4, 4) = "A col4 row4"

so going by this principal i tried to sort the array by the 2nd column. I tried various examples from other sites but they all say that "subscript out of range"

can anyone please let me know if I am going about this completely the wrong way. Any help greatly appreciated. Thanks

    Dim MyArray(1 To 4, 1 To 4)
    Dim i As Integer, j As Integer

    MyArray(1, 1) = "A col1 row1"
     MyArray(1, 2) = "C col1  row2"
     MyArray(1, 3) = "D col1  row3"
     MyArray(1, 4) = "B col1  row4"
     MyArray(2, 1) = "D col2  row1 - sort this col"
     MyArray(2, 2) = "B col2   row2 - sort this col"
     MyArray(2, 3) = "A col2   row3 - sort this col"
     MyArray(2, 4) = "C col2   row4 - sort this col"
     MyArray(3, 1) = "A col3  row1"
     MyArray(3, 2) = "D col3 row2"
     MyArray(3, 3) = "B col3 row3"
     MyArray(3, 4) = "C col3 row4"
     MyArray(4, 1) = "D col4 row1"
     MyArray(4, 2) = "C col4 row2"
     MyArray(4, 3) = "B col4 row3"
     MyArray(4, 4) = "A col4 row4"
 
 SortColumm1 = 1
 SortColumn2 = 3
 For i = LBound(MyArray, 1) To UBound(MyArray, 1) - 1
      For j = LBound(MyArray, 1) To UBound(MyArray, 1) - 1
          Condition1 = MyArray(j, SortColumn1) > MyArray(j + 1, SortColumn1)
          Condition2 = MyArray(j, SortColumn1) = MyArray(j + 1, SortColumn1) And _
                     MyArray(j, SortColumn2) > MyArray(j + 1, SortColumn2)

          If Condition1 Or Condition2 Then
               For y = LBound(MyArray, 2) To UBound(MyArray, 2)
                   t = MyArray(j, y)
                   MyArray(j, y) = MyArray(j + 1, y)
                   MyArray(j + 1, y) = t
                   Next y
               End If
          Next
      Next

 

[kpark91]

Constraints:
column space is independent from the row space.
It is a 4 x 4 matrix (array).
x (i , j) indicates an element at ith column and jth row.

Sub SortTwoDimensionalArray()
       
    Dim MyArray(1 To 4, 1 To 4)
    Dim i As Long, j As Long, temp As String
    MyArray(1, 1) = "A c1r1"
    MyArray(1, 2) = "C c1r2"
    MyArray(1, 3) = "D c1r3"
    MyArray(1, 4) = "B c1r4"
    MyArray(2, 1) = "D c2r1"
    MyArray(2, 2) = "B c2r2"
    MyArray(2, 3) = "A c2r3"
    MyArray(2, 4) = "C c2r4"
    MyArray(3, 1) = "A c3r1"
    MyArray(3, 2) = "D c3r2"
    MyArray(3, 3) = "B c3r3"
    MyArray(3, 4) = "C c3r4"
    MyArray(4, 1) = "D c4r1"
    MyArray(4, 2) = "C c4r2"
    MyArray(4, 3) = "B c4r3"
    MyArray(4, 4) = "A c4r4"
    
    'Sort column 2 (slowest sorting algorithm) increasing rightward
    For i = 1 To 3
        For j = i + 1 To 4
            'Sort ColB
            If MyArray(2, i) > MyArray(2, j) Then
                temp = MyArray(2, i)
                MyArray(2, i) = MyArray(2, j)
                MyArray(2, j) = temp
            End If
            'Sort ColA
            If MyArray(1, i) > MyArray(1, j) Then
                temp = MyArray(1, i)
                MyArray(1, i) = MyArray(1, j)
                MyArray(1, j) = temp
            End If
        Next j
    Next i
    
    'Print on spreadsheet
    For i = 1 To 4
        For j = 1 To 4
            Cells(i, j).Value = MyArray(j, i) 'Transposition
        Next j
    Next i
End Sub

 

[fat-tony]

Ahh well. I see why you put 'columns' at first then :P
Could I see the code that is able to redim all the dimensions of an array please if you don't mind?

As for your sorting by colB then colA..
I just read it right now and in what ways do you want them sorted?

like just column A and column B independent from the rows the elements of column space are in, right?

The 2nd Column (B) would be the first sort layer. All 4 columns would be sorted so that the rows do not get mixed up.
However if there are two entrys with the same string in Col(B) then it would be sorted for a 2nd layer using the first Column (A), once again keeping all the columns in the row constant so that they dont get mixed up.

if the multi-layered sort does not work, its not the end of the world. But by changing the columns and rows from the original solution code posted above, i have broken the previous solutions.

This is a sanitised version of the code. I know I could use Row instead of making another variable 'tCount' but I was using later in the if statement.

dim tCount as long, Row as long, a as long, j as long
Dim myArray() As String
tCount = 0

For Row = 1 To 100
    tCount = tCount + 1
    ReDim Preserve myArray(1 To 4, 1 To tCount)
    myArray(1, tCount) = "Col1 Row" & tCount
    myArray(2, tCount) = Sheets("Sheet1").Cells(tCount, 1).Value & "Col2 Row" & tCount
    myArray(3, tCount) = "Col3 Row" & tCount
    myArray(4, tCount) = "Col4 Row" & tCount
Next Row

If tCount > 0 Then
    For a = 1 To UBound(myArray, 1) 'cols , only have 4 cols
      For j = 1 To UBound(myArray, 2) 'rows , 100 rows for now
        Sheets("Sheet2").Cells(j, a).Value = myArray(a, j)
      Next j
    Next a
End If

 

[fat-tony]

Hi,

This seems to mix up the row associated columns.

A c1r1    A c2r3    A c3r1    D c4r1
B c1r4    B c2r2    D c3r2    C c4r2
C c1r2    C c2r4    B c3r3    B c4r3
D c1r3    D c2r1    C c3r4    A c4r4

Cheers bud.

Constraints:
column space is independent from the row space.
It is a 4 x 4 matrix (array).
x (i , j) indicates an element at ith column and jth row.

Sub SortTwoDimensionalArray()
       
    Dim MyArray(1 To 4, 1 To 4)
    Dim i As Long, j As Long, temp As String
    MyArray(1, 1) = "A c1r1"
    MyArray(1, 2) = "C c1r2"
    MyArray(1, 3) = "D c1r3"
    MyArray(1, 4) = "B c1r4"
    MyArray(2, 1) = "D c2r1"
    MyArray(2, 2) = "B c2r2"
    MyArray(2, 3) = "A c2r3"
    MyArray(2, 4) = "C c2r4"
    MyArray(3, 1) = "A c3r1"
    MyArray(3, 2) = "D c3r2"
    MyArray(3, 3) = "B c3r3"
    MyArray(3, 4) = "C c3r4"
    MyArray(4, 1) = "D c4r1"
    MyArray(4, 2) = "C c4r2"
    MyArray(4, 3) = "B c4r3"
    MyArray(4, 4) = "A c4r4"
    
    'Sort column 2 (slowest sorting algorithm) increasing rightward
    For i = 1 To 3
        For j = i + 1 To 4
            'Sort ColB
            If MyArray(2, i) > MyArray(2, j) Then
                temp = MyArray(2, i)
                MyArray(2, i) = MyArray(2, j)
                MyArray(2, j) = temp
            End If
            'Sort ColA
            If MyArray(1, i) > MyArray(1, j) Then
                temp = MyArray(1, i)
                MyArray(1, i) = MyArray(1, j)
                MyArray(1, j) = temp
            End If
        Next j
    Next i
    
    'Print on spreadsheet
    For i = 1 To 4
        For j = 1 To 4
            Cells(i, j).Value = MyArray(j, i) 'Transposition
        Next j
    Next i
End Sub

 

[shg]

Why not just sort directly on the worksheet? It would be faster and simpler.

 

[fat-tony]

Why not just sort directly on the worksheet? It would be faster and simpler.

It is so that the macro will work to automate the process and generate reports without the user then manipulating the sort or structure manually.

I know what you mean, would be easier just to dump it to the sheet and click 'Sort' but this has started to become a battle I dont want the VBA to win. I know it 'can' be done, just not how.

 

[kpark91]

Oh. I thought this thread was done lol.
My bad :P

Here is the code for sorting colB then sorting colA with the rows UNCHANGED.

Sub SortTwoDimensionalArray()
 
    Dim MyArray(1 To 4, 1 To 4)
    Dim i As Long, j As Long, k As Long, temp As String
 
    MyArray(1, 1) = "A c1r1"
    MyArray(1, 2) = "C c1r2"
    MyArray(1, 3) = "D c1r3"
    MyArray(1, 4) = "B c1r4"
    MyArray(2, 1) = "D c2r1"
    MyArray(2, 2) = "B c2r2"
    MyArray(2, 3) = "A c2r3"
    MyArray(2, 4) = "C c2r4"
    MyArray(3, 1) = "A c3r1"
    MyArray(3, 2) = "D c3r2"
    MyArray(3, 3) = "B c3r3"
    MyArray(3, 4) = "C c3r4"
    MyArray(4, 1) = "D c4r1"
    MyArray(4, 2) = "C c4r2"
    MyArray(4, 3) = "B c4r3"
    MyArray(4, 4) = "A c4r4"
 
    'Sort column 2 (slowest sorting algorithm) increasing rightward
    For i = 1 To 3
        For j = i + 1 To 4
            'Sort ColB
            If MyArray(2, i) > MyArray(2, j) Then
                'Traverse through the columns to keep the row the 'same'
                For k = 1 To 4
                    temp = MyArray(k, i)
                    MyArray(k, i) = MyArray(k, j)
                    MyArray(k, j) = temp
                Next k
            End If
            'Sort ColA
            If MyArray(1, i) > MyArray(1, j) Then
                'Traverse through the columns to keep the row the 'same'
                For k = 1 To 4
                    temp = MyArray(k, i)
                    MyArray(k, i) = MyArray(k, j)
                    MyArray(k, j) = temp
                Next k
            End If
        Next j
    Next i
 
    'Print on spreadsheet
    For i = 1 To 4
        For j = 1 To 4
            Cells(i, j).Value = MyArray(j, i) 'Transposition
        Next j
    Next i
End Sub

Edit: If you want it more generic, I won't mind :P
but if you are making it more generic yourself, could you post it up for me please?
I think it could get in handy and I could possible optimize it.

 

[fat-tony]

Ahoy

I have made something cheeky, I am sure that it cannot be healthy but it works to create dynamic 2D array with the Rows first and the Cols second.

Sub PleaseWork()
    Dim tCount As Long, Row As Long, Col As Long, i As Long, j As Long
    Dim srcNumRows As Long, srcNumCols As Long
    Dim myArray() As String

    'get the number of cols in the source sheet
    srcNumCols = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
    'get the number of rows in the source sheet
    srcNumRows = Sheets("Sheet1").Cells(Application.Rows.Count, 1).End(xlUp).Row

    'using reDim as I am not using constant expression for the values
    ReDim myArray(1 To srcNumRows, 1 To srcNumCols)

    For Row = 1 To srcNumRows    'for each row in the source sheet
        For Col = 1 To srcNumCols   'for each col in the source sheet
            'populate the array with the values from the source sheet
            myArray(Row, Col) = Sheets("Sheet1").Cells(Row, Col).Value
        Next Col
    Next Row

    'now to iterate through the array and spit out the values in the destination sheet
    'before this bit the sorting code would go
    For i = LBound(myArray, 1) To UBound(myArray, 1)
        For j = LBound(myArray, 2) To UBound(myArray, 2)
            Sheets("Sheet2").Cells(i, j).Value = myArray(i, j)
        Next j
    Next i
End Sub

 

[kpark91]

Oh wow. saw your code and noticed you switched your columns and rows now for your array coordinates -_-

 

[kpark91]

This will be your sorting code then

    For i = 1 To srcNumRows - 1
        For j = i + 1 To srcNumRows
            If myArray(i, 2) > myArray(j, 2) Then
                For k = 1 To srcNumCols
                    temp = myArray(i, k)
                    myArray(i, k) = myArray(j, k)
                    myArray(j, k) = temp
                Next k
            End If
            If myArray(i, 1) > myArray(j, 1) Then
                For k = 1 To srcNumCols
                    temp = myArray(i, k)
                    myArray(i, k) = myArray(j, k)
                    myArray(j, k) = temp
                Next k
            End If
        Next j
    Next i

keep in mind that this will be slow as O(n ^ 3) algorithm.

I haven't had the change to optimize it.
You might want to take a look at speedSort on the internet.

 

[fat-tony]

*removed*