the:behavioral:lab

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  
Advertisements

Single Post Navigation

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: