Sorting a 3 dimensional array in Excel
Never learned visual basic. Never thought I would use Excel enough to learn VBA. Then someone asked my to alphabetically order 500 individual rows of what can be characterized as a 3 dimensional array. Rather than spend 5 hours doing that by hand I spent 6 learning VBA and created a macro for it.
A quick overview: I received a file with about 500 rows. Each row had 220, 4-column groupings of data (i.e. column 1-4 go together and must stay together when sorting, 5-9 go together, etc.). This is probably the most logical way to put a 3 dimensional array in Excel. It makes it hard to sort though, since Excel can’t do the grouping very well. I solve this by concatenating the groupings with a delimiter. I then sort, create columns, and split the concatenated cells into columns again. To run the macro you need data with no headers and 4 columns per grouping. If your data is different you’ll need to edit the parameters in the macro.
1: Sub SortData()
2: Application.ScreenUpdating = False
3: 'concatenate data using ! as delimiter, clearing previous contents of cells
4: For rowx = 1 To Cells(Rows.Count, 1).End(xlUp).Row
5: For colx = 1 To Cells(rowx, Columns.Count).End(xlToLeft).Column Step 4
6: Cells(rowx, colx) = Cells(rowx, colx).Value() & "!" & Cells(rowx, colx + 1).Value() & "!" & Cells(rowx, colx + 2).Value() & "!" & Cells(rowx, colx + 3).Value()
7: Cells(rowx, colx + 1).ClearContents
8: Cells(rowx, colx + 2).ClearContents
9: Cells(rowx, colx + 3).ClearContents
10: Next colx
11: Next rowx
12: 'Sort Rows Individually
13: For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row
14: Range(Cells(r, 1), Cells(r, Columns.Count)).Select
15: Selection.Sort Key1:=Cells(r, 2), Order1:=xlAscending, Header:=xlGuess, _
16: OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
17: DataOption1:=xlSortNormal
18: Next r
19: 'Insert columns after each entry
20: For colx = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
21: Columns((colx - 1) * 4 - 2).Insert Shift:=xlToRight
22: Columns((colx - 1) * 4 - 2).Insert Shift:=xlToRight
23: Columns((colx - 1) * 4 - 2).Insert Shift:=xlToRight
24: Next
25: 'Split cells using ! as delimiter
26: For colx = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 4
27: Columns(colx).Select
28: Selection.TextToColumns Destination:=Cells(1, colx), DataType:=xlDelimited, _
29: TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
30: Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
31: :="!", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
32: TrailingMinusNumbers:=True
33: Next
34: Application.ScreenUpdating = True
35: Range("A1").Select
36: End Sub
