Sort Excel VBA Macro Row Groups

Question

I find it difficult to figure out how to create a sorting algorithm in VBA that sorts and swaps groups of rows (several rows at a time). I wrote a successful sorting algorithm using the following array:

Function SortArray(ByRef arrToSort As Variant) Dim aLoop As Long, aLoop2 As Long Dim str1 As String Dim str2 As String For aLoop = 1 To UBound(arrToSort) For aLoop2 = aLoop To UBound(arrToSort) If UCase(arrToSort(aLoop2)) < UCase(arrToSort(aLoop)) Then str1 = arrToSort(aLoop) str2 = arrToSort(aLoop2) arrToSort(aLoop) = str2 arrToSort(aLoop2) = str1 End If Next aLoop2 Next aLoop SortArray = arrToSort 

(where each element is an array element), but now I want to sort by replacing strings or groups of strings. I will explain what I mean below.

I have a worksheet with headers at the top and data lines at the bottom:

I want to write a command that works like the algorithm above. HOWEVER, instead of replacing array elements, I want to swap entire groups of strings . Header3 ((can be any string) defines the grouping. All groups on the sheet are sorted separately and grouped.

To make swapped grouped strings, I wrote the following sub RowSwapper (), which accepts two strings containing strings for exchange. (for example, in the form rws1 = "3: 5").

 Public Sub RowSwapper(ByVal rws1 As String, ByVal rws2 As String) 'ACCOMODATE VARIABLE ROW LENGTHS!!!! ActiveSheet.Rows(rws1).Cut ActiveSheet.Rows(rws2).Insert Shift:=xlDown ActiveSheet.Rows(rws2).Cut ActiveSheet.Rows(rws1).Insert Shift:=xlDown MsgBox "RowSwapper: row" & rws1 & "swapped with row " & rws2 End Sub 

Any ideas? My strategy, including code, is given below:

MY STRATEGY: I have arrays prLst and srtdPrLst. prLst is an array of sorting priorities. The priority position in prLst is the column (header) to which it refers. srtdPrLst, is an array containing these priorities, sorted in ascending order of number (for example, 1,2,3 ....)

I go through srtdPrLst, calling the FindPosition function to find the position of each priority. I loop back to sort in the correct order.

To sort the groups of rows, I then use the same method as the SortArray code above. However, I need to collect the rows in which the group exists. To do this, I have two Do While loops nested in the for loops, one for each group (since I am comparing two groups in). These lines are stored in the variables grpCnt1 (for the first compared group) and grpCnt1 (for the second compared group).

Since the individual groups are already sorted, I only need to compare the first row of each group. I am comparing strings grp1Val with grp2Val with a simple If statement. If the strings are not in alphabetical order, I call rowSwapper (see above) to replace them.

The code is described below:

lstRowVal = Int (ActiveSheet.Range ("AB" and totCount) .Value) 'The index in the prLst array is the column in which priority is assigned' therefore, pos = the column number "Sorts back to get priorities in the pre-holiday 'MsgBox" marker = "and marker

 For prior2 = Int(UBound(srtdPrLst)) To 1 Step -1 MsgBox "prior2 = " & prior2 If Int(srtdPrLst(prior2)) > 0 Then pos = FindPosition(Int(srtdPrLst(prior2)), prLst) 'Algorithm to sort groups For lLoop = 2 To lstRowVal '2 b/c Starts at row below headers 'Find first group to compare grp1Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & lLoop).Value hdToGrp1Val = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & lLoop).Value Do 'nextGrp1Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & (lLoop + grpCnt1)).Value nxtHdToGrp1 = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & (lLoop + grpCnt1)).Value grpCnt1 = grpCnt1 + 1 Loop While nxtHdToGrp1 = hdToGrp1Val For lLoop2 = lLoop To lstRowVal 'Find second group to compare grp2Val = ActiveSheet.Range(Mid(alphabet, pos, 1) & lLoop2).Value hdToGrp2Val = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & lLoop2).Value Do nxtHdToGrp2 = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) & (lLoop2 + grpCnt2)).Value grpCnt2 = grpCnt2 + 1 Loop While nxtHdToGrp2 = hdToGrp2Val If UCase(grp2Val) < UCase(grp1Val) Then RowSwapper lLoop & ":" & (lLoop + grpCnt1), lLoop2 & ":" & (lLoop2 + grpCnt2) End If grp2Val = "" lLoop2 = lLoop2 + grpCnt2 grpCnt2 = 0 Next lLoop2 grp1Val = "" lLoop = lLoop + grpCnt1 grpCnt1 = 0 Next lLoop End If Next prior2 

Answer 1

I agree that the question remains a bit unclear. You tried to sort from Data> Sort ... You can sort multiple keys and use custom lists.

Also, since you said that you need some pointers to VBA ... :) I don't think things like

 Dim letString, idLabel, curCell As String 

does what you expect. What actually happens here:

 Dim letString as Variant, idLabel as Variant, curCell As String 

because you do not specify after each variable. I assume what you really want here:

 Dim letString as String, idLabel as String, curCell As String 

Secondly, if you are concerned about efficiency, as in your last comment, I would not use the .select method to control ranges. You can do everything in it without it. This is just an additional burden. So instead of doing something like Selction.Resize(1).Select , you can write the beginning and end locations of your rand in an integer variable, and then change it to a range object as soon as all your criteria are met. You can feed this range object into your sort function.

Just something to chew on.