View Full Version : [SOLVED:] Sort blocks independently
Klartigue
01-08-2015, 08:50 AM
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
01-08-2015, 09:24 AM
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
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.