Excel VBA Sort Largest to Smallest with Row Groups

B

Biz

Well-known Member
Joined
May 18, 2009
Messages
1,773
Office Version
  1. 2021
Platform
  1. Windows
Dear All,

I'm having a very hard time trying sort data in Column C from largest to smallest and also maintaining the row grouping.
Can someone please help me by creating VBA code which can handle this task?

Screenshot below without row grouping
Sheet1

ABCDEFGHI
1Sample
2Store NoStoreAmount
3 Parramatta50
460Store220
570Store330
680Store4100
7 Westmead3
890store 51
9100Store 62
10
11
12 Desired Result
13 Store NoStoreAmount
14 80Store4100
15 Parramatta50
16 60Store220
17 70Store330
18 Westmead3
19 90store 51
20 100Store 62
21
22
23

<colgroup><col style="width: 30px;"><col style="width: 75px;"><col style="width: 75px;"><col style="width: 64px;"><col style="width: 64px;"><col style="width: 64px;"><col style="width: 98px;"><col style="width: 75px;"><col style="width: 64px;"><col style="width: 64px;"></colgroup><tbody>
</tbody>

Formeln der Tabelle
ZelleFormel
C3=SUM(C4:C5)
C7=SUM(C8:C9)
H15=SUM(H16:H17)
H18=SUM(H19:H20)

<tbody>
</tbody>

<tbody>
</tbody>

Screenshot with row grouping
Sheet1

ABCDEFGHI
1Sample
2Store NoStoreAmount
3 Parramatta50
680Store4100
7 Westmead3
10
11
12 Desired Result
13 Store NoStoreAmount
14 80Store4100
15 Parramatta50
18 Westmead3
21
22
23

<colgroup><col style="width: 30px;"><col style="width: 75px;"><col style="width: 75px;"><col style="width: 64px;"><col style="width: 64px;"><col style="width: 64px;"><col style="width: 98px;"><col style="width: 75px;"><col style="width: 64px;"><col style="width: 64px;"></colgroup><tbody>
</tbody>

Formeln der Tabelle
ZelleFormel
C3=SUM(C4:C5)
C7=SUM(C8:C9)
H15=SUM(H16:H17)
H18=SUM(H19:H20)

<tbody>
</tbody>

<tbody>
</tbody>

Your help would be greatly appreciated.

Kind Regards,

Biz
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
Hi Biz,
Try this code:
Rich (BB code): 
Sub Uotline()
 
  Dim a()
  Dim i As Long, j As Long
  Dim Total As Double, v As Double
  Dim Rng As Range
 
  Set Rng = Range("A2:C9")
  Application.DisplayAlerts = False
  ActiveSheet.Outline.AutomaticStyles = False
  Rng.AutoOutline
 
  a() = Rng.Resize(, 4).Value
  v = 1
  For i = 2 To UBound(a)
    If Trim(a(i, 1)) = "" Or v = 0 Then
      Total = a(i, 3)
    Else
      v = Total - a(i, 3)
    End If
    a(i, 4) = Total
  Next
 
  With Rng.Offset(UBound(a) + 3, UBound(a, 2) + 1).Resize(, 4)
    .Value = a()
    .Columns(3).FormulaR1C1 = Rng.Columns(3).FormulaR1C1
    .Sort .Cells(1, 4), xlDescending, Header:=xlYes
    .Columns(4).ClearContents
    .Resize(UBound(a)).Offset(1).AutoOutline
  End With
  Application.DisplayAlerts = True
 
End Sub
Regards
 
Last edited:
Upvote 0
More correct code:
Rich (BB code): 
Sub Outline()
 
  Dim a()
  Dim i As Long, j As Long
  Dim Total As Double, v As Double
  Dim Rng As Range
 
  Set Rng = Range("A2:C9")
  Application.DisplayAlerts = False
  ActiveSheet.Outline.AutomaticStyles = False
  Rng.AutoOutline
 
  a() = Rng.Resize(, 4).Value
  For i = 2 To UBound(a)
    If Trim(a(i, 1)) = "" Or v = 0 Then
      Total = a(i, 3)
      v = Total
    Else
      v = Round(v - a(i, 3), 3)
    End If
    a(i, 4) = Total
  Next
 
  With Rng.Offset(UBound(a) + 3, UBound(a, 2) + 1).Resize(, 4)
    .Value = a()
    .Columns(3).FormulaR1C1 = Rng.Columns(3).FormulaR1C1
    .Sort .Cells(1, 4), xlDescending, Header:=xlYes
    .Columns(4).ClearContents
    .Resize(UBound(a)).Offset(1).AutoOutline
  End With
  Application.DisplayAlerts = True
 
End Sub
 
Last edited:
Upvote 0
Hi Vladmir,

The code is nearly correct except I don't want the data to move to Desired Result area at all, but I sorts the original data to sorted in Rng.

Hope it makes sense.

Kind Regards

Biz
 
Upvote 0
It's even simpler: :)
Rich (BB code): 
Sub Outline()
 
  Dim a()
  Dim i As Long
  Dim Total As Double, v As Double
  Dim Rng As Range
 
  Set Rng = Range("A2:C9")
  a() = Rng.Value
  For i = 2 To UBound(a)
    If Trim(a(i, 1)) = "" Or v = 0 Then
      Total = a(i, 3)
      v = Total
    Else
      v = Round(v - a(i, 3), 3)
    End If
    a(i, 1) = Total
  Next
 
  Application.ScreenUpdating = False
  i = Rng.Columns.Count + 1
  With Rng.Resize(, i)
    .Columns(i).Insert
    .Columns(i).Value = a()
    .Sort .Cells(1, i), xlDescending, Header:=xlYes
    .Columns(i).Delete
    Application.DisplayAlerts = False
    ActiveSheet.Outline.AutomaticStyles = False
    .Resize(UBound(a) - 1, i - 1).Offset(1).AutoOutline
    Application.DisplayAlerts = True
  End With
  Application.ScreenUpdating = True
 
End Sub
Best Regards!
 
Last edited:
Upvote 0
Hi Vladimir,

The code in post 5 gives the wrong result. I believe when we are sorting the cells in Descending order in Column C, results in giving the incorrect result. Unfortunately, I need to have grouping with the formula. The results after sorting doesn't match the desired results which should be rng.

Kind Regards,

Biz
 
Upvote 0
I am now out of PC, will return back in hours to tesr & update the code
 
Upvote 0
For me the code of post #5 is working, but note that it was modified after the posting.
Try this a bit modified code. If it does not work as expected then please post back input data and expected output data.
Rich (BB code): 
Sub Outline()
 
  Dim a()
  Dim i As Long
  Dim Total As Double, v As Double
  Dim Rng As Range
 
  Set Rng = Range("A2:C9")
  a() = Rng.Value
  For i = 2 To UBound(a)
    If Trim(a(i, 1)) = "" Or v = 0 Then
      Total = a(i, 3)
      v = Total
    Else
      v = Round(v - a(i, 3), 3)
    End If
    a(i, 1) = Total
  Next
 
  Application.ScreenUpdating = False
  i = Rng.Columns.Count + 1
  Rng.Columns(i).Insert
  With Rng.Resize(, i)
    .Columns(i).Value = a()
    .Sort .Cells(1, i), xlDescending, Header:=xlYes
    .Columns(i).Delete
    Application.DisplayAlerts = False
    ActiveSheet.Outline.AutomaticStyles = False
    .Resize(UBound(a) - 1, i - 1).Offset(1).AutoOutline
    Application.DisplayAlerts = True
  End With
  Application.ScreenUpdating = True
 
End Sub
 
Last edited:
Upvote 0
Hi,

I tried and I get desired output (see below)

Sheet1

F
G
H
12
Desired Result
13
Store No
Store
Amount
14
80
Store4
100
15
Parramatta
50
18
Westmead
3

<tbody>
</tbody>

Formeln der Tabelle

Zelle
Formel
H15
=SUM(H16:H17)
H18
=SUM(H19:H20)


<tbody>
</tbody>

<tbody>
</tbody>
 
Last edited:
Upvote 0
Biz said:
I tried and I get desired output (see below)
Click to expand...
That's good, thank you for the confirming.
Looks like input & output data are in F13:H20 instead of A2:C9 and you've successfully changed it in the Set Rng =... line of the code.
Cheers!
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
Value corresponding to flag cell
Replies
5
Views
821
Fluff
Fluff
H
  • Question
Fill values top down
2 3
Replies
25
Views
2K
hsandeep
H
H
  • Question
Either of 4 cells equals a value then get the desired result
Replies
2
Views
633
hsandeep
H
H
  • Question
REVERSE the data corresponding to value in the flag cell
2
Replies
11
Views
1K
Peter_SSs
Peter_SSs
B
  • Question
Sumproduct Tiered % Bud Achieved Bonus Twist
Replies
5
Views
724
Biz
B

Forum statistics

Threads
1,214,642
Messages
6,120,701
Members
448,980
Latest member
CarlosWin

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top