Sort an excel sheet with specific conditions (vba)

user_13613718 0
Viewed 44

Here is my problem, I have those data on my Sheet1

       A      B        C
   1 Name   Account  Amount 
   2 John   HSBC     -20000
   3 Ashley JPM      140000
   4 Rose   BAML     70000
   5 John   DB       10000
   6 Rose   Barclays -25000
   7 Ashley JPM      -3000

My goal is to use vba in order to sort lines and group them by name and amount. The result that I'm looking for in Sheet2 is :

       A      B        C
   1 Name   Account  Amount 
   2 John   HSBC     -20000
   3 John   DB       10000
   4
   5 Ashley JPM      -3000
   6 Ashley JPM      140000
   7
   8 Rose   Barclays -25000
   9 Rose   BAML     70000

I already succeeded in taking the negative values first, but I still have difficulties in taking the rest and leave a blank line between groups.

Here is the code that I started :

Option Explicit

Sub sort_account()

Dim list_amount As Range, amount As Range
Dim b As Integer

Worksheets("Sheet1").Activate
Set list_amount = Worksheets("Sheet1").Range("C2", Range("C2").End(xlDown))

For Each amount In list_amount
    If amount.Value < 0 Then
        
        b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Sheet2").Cells(b + 1, 1).Value = amount.Offset(0, -2)
        Worksheets("Sheet2").Cells(b + 1, 2).Value = amount.Offset(0, -1)
        Worksheets("Sheet2").Cells(b + 1, 3).Value = amount
        
    End If
Next amount

Worksheets("Sheet2").Activate

End Sub

And this gives me as a result :

       A      B        C
   1 Name   Account  Amount 
   2 John   HSBC     -20000
   5 Ashley JPM      -3000
   8 Rose   Barclays -25000

I really have difficulties for the rest. Do you have any ideas ? I thank you in advance for that.

Nb : The order doesn't matter, I just want that the first values of each group is the negative amount.

Thanks!

grouping vba excel sorting loops
2 Answers

If your version of Excel supports Dynamic Arrays then you can do the following

Sample with highlights

This solution adds an extra row for each unique name, sorts the new data, and then blanks out the added rows.

E2 is =CHOOSE({1,2,3},UNIQUE(A2:A7),"temp",99999999). This creates an array with all the unique names in the first column, "temp" in the second column and 99999999 in the third (to be used for sorting).

F6 is =ROWS(A2:C7) the count of the rows in the data F7 is =ROWS(E2#) the count of unique names

A10 is =IF(SEQUENCE(F6+F7)<=F6,A2:C7,INDEX(E2#,SEQUENCE(F6+F7)-F6,SEQUENCE(1,3))). This appends the original data to the new data.

E10 is =SORT(A10#,{1,3}), the appended data sorted.

I10 is =IF(F10:F18="temp","",E10#). This blanks out all the temps rows.

If your version of Excel supports LET you can do this in one cell.

=LET(data,A2:C7,
     tempRows,CHOOSE({1,2,3},UNIQUE(A2:A7),"temp",99999999),
     totalRows,ROWS(data),
     uniqueNames,ROWS(tempRows),
     outRows, SEQUENCE(totalRows+uniqueNames),
     unsorted,IF(outRows<=totalRows,data,INDEX(tempRows,outRows-totalRows,{1,2,3})),
     sorted,SORT(unsorted,{1,3}),
     result, IF(INDEX(sorted,outRows,2)="temp","",INDEX(sorted,outRows,{1,2,3})),
 result)
user_143854190

If this were my project, I would do it in three distinct steps: Copy all the data from sheet 1 to sheet 2; Sort the data in the preferred order; Insert the blank rows, starting from the bottom. The following code should do what you’re after.

Option Explicit
Sub sort_account()
Dim LastRow As Long, i As Long

Sheet2.Cells.ClearContents
Sheet1.UsedRange.Copy Sheet2.Range("A1")

Sheet2.Columns("A:C").Sort Key1:=Sheet2.Range("A2"), order1:=xlAscending, _
Key2:=Sheet2.Range("C2"), order2:=xlAscending, Header:=xlYes

LastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 4 Step -1
    If Sheet2.Cells(i, "A") = Sheet2.Cells(i - 1, 1) Then
        Sheet2.Cells(i - 1, "A").EntireRow.Insert
    End If
Next i

End Sub
Admin1
Related