Sort blocks independently

[Klartigue]

On the attached, is there a VBA code to use that can sort each block? Each block is identified by a highlighted green line and below each green line is the breakdown for each block. Is there a way to sort each block individually by identifying the green line and using a code to tell excel to sort the data below the green line all the way to the blank row (and stopping before the next green line)? And it would be sorted by column G. And do that sort for each block trade there is on the sheet? The desired results are on the second sheet.

Any help is appreciated!

[Paul_Hossler]

I'd do something like this




Option Explicit
Sub SortByColG()
Dim rBroker As Range, rArea As Range, rSort As Range


Set rBroker = ActiveSheet.Columns(1).SpecialCells(xlCellTypeConstants, 23)

For Each rArea In rBroker.Areas
Set rSort = rArea.CurrentRegion

'adjust for header row and custodian row
If rSort.Rows(1).Row = 1 Then
'header row + total row + single data row = 3 rows so no need to sort
If rSort.Rows.Count <= 3 Then GoTo NextArea
Set rSort = rSort.Cells(3, 1).Resize(rSort.Rows.Count - 2, rSort.Columns.Count)
Else
'NO header row + total row + single data row = 2 rows so no need to sort
If rSort.Rows.Count <= 2 Then GoTo NextArea
Set rSort = rSort.Cells(2, 1).Resize(rSort.Rows.Count - 1, rSort.Columns.Count)

End If

With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=rSort.Columns(7), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rSort
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
NextArea:
Next

Range("A1").Select

End Sub

[snb]

Sub M_snb()
With Sheet1.UsedRange
.Rows(2).Insert

.Columns(7).AdvancedFilter 2, , Sheet1.Cells(1, 20), True
sn = .Columns(20).Offset(1).SpecialCells(2)
.Columns(20).ClearContents

For Each ar In .Columns(1).SpecialCells(2).Areas
ar.CurrentRegion.Sort ar.Offset(, 6), 1, , , , , , 2
Next

With .Resize(, 12)
For Each it In sn
.AutoFilter 7, it
For Each ar In .Columns(7).Offset(1).SpecialCells(12).Areas
ar.Cells(1).Offset(, 3) = Application.Sum(ar.Offset(, 2))
Next
.AutoFilter
Next
End With
End With
End Sub