Note that there are some explanatory texts on larger screens.

plurals
  1. POSorting Groups of Rows Excel VBA Macro
    primarykey
    data
    text
    <p>I am having trouble figuring 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 an array below: </p> <pre><code>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)) &lt; UCase(arrToSort(aLoop)) Then str1 = arrToSort(aLoop) str2 = arrToSort(aLoop2) arrToSort(aLoop) = str2 arrToSort(aLoop2) = str1 End If Next aLoop2 Next aLoop SortArray = arrToSort </code></pre> <p>(where each element is an element of an array) but now I want to sort by swapping rows or groups of rows. I'll explain what I mean below.</p> <p>I have a worksheet with headers at the top and rows of data underneath:</p> <p><img src="https://i.stack.imgur.com/ysGeu.jpg" alt="Worksheet"></p> <p>I want to write a command that works like the algorithm above. HOWEVER, <strong>instead of swapping elements of an array I want to swap entire groups of rows</strong>. Header3 ((Can be any string) determines the grouping. All groups on the worksheet are sorted individually and a grouping.</p> <p>In order to do swap grouped rows, I wrote the following sub RowSwapper() that takes in two strings containing the rows to swap. (e.g. in the form rws1 = "3:5").</p> <pre><code>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" &amp; rws1 &amp; "swapped with row " &amp; rws2 End Sub </code></pre> <p><strong>Any ideas?</strong> My strategy, including code, is listed below:</p> <p>MY STRATEGY: I have the arrays prLst and srtdPrLst. prLst is an array of sorting priorities. The position of the priority in prLst is the column (header) to which it refers. srtdPrLst, is an array containing those priorities sorted in numerically ascending order (e.g. 1,2,3....)</p> <p>I loop through srtdPrLst while calling function FindPosition to find position of each priority. I loop backwards in order to sort in the proper order. </p> <p>To sort groups of rows, I then use the same technique as the SortArray code above. However, I need to gather the rows in which a group exists. To do this, I have two Do While loops nested under the for loops, one for each group (since I am comparing two groups at). These rows are stored in variables grpCnt1 (for first compared group) and grpCnt1 (for second compared group). </p> <p>Since individual groups are already sorted, I only need to compare the first row of each group. I compare the strings grp1Val with grp2Val with a simple If statement. If the strings are not in alphabetical order, I call rowSwapper (listed above) to swap them.</p> <p>The code described is below:</p> <p>lstRowVal = Int(ActiveSheet.Range("AB" &amp; totCount).Value) 'The index in the array prLst is the column at which a priority is assigned to 'therefore, pos = column number 'Sorts backwards in order to get priorities in appriopriate order 'MsgBox "marker = " &amp; marker</p> <pre><code>For prior2 = Int(UBound(srtdPrLst)) To 1 Step -1 MsgBox "prior2 = " &amp; prior2 If Int(srtdPrLst(prior2)) &gt; 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) &amp; lLoop).Value hdToGrp1Val = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) &amp; lLoop).Value Do 'nextGrp1Val = ActiveSheet.Range(Mid(alphabet, pos, 1) &amp; (lLoop + grpCnt1)).Value nxtHdToGrp1 = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) &amp; (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) &amp; lLoop2).Value hdToGrp2Val = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) &amp; lLoop2).Value Do nxtHdToGrp2 = ActiveSheet.Range(Mid(alphabet, hdrMrkr, 1) &amp; (lLoop2 + grpCnt2)).Value grpCnt2 = grpCnt2 + 1 Loop While nxtHdToGrp2 = hdToGrp2Val If UCase(grp2Val) &lt; UCase(grp1Val) Then RowSwapper lLoop &amp; ":" &amp; (lLoop + grpCnt1), lLoop2 &amp; ":" &amp; (lLoop2 + grpCnt2) End If grp2Val = "" lLoop2 = lLoop2 + grpCnt2 grpCnt2 = 0 Next lLoop2 grp1Val = "" lLoop = lLoop + grpCnt1 grpCnt1 = 0 Next lLoop End If Next prior2 </code></pre>
    singulars
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload