How do I match values in a sub set after a sort?
On Thu, 10 Jan 2013 02:44:58 +0000, DavidOakland wrote:
This is kind of complex I think, but I'm hoping someone might have an
easy solution. I need to sort two columns for match parings, but the
second column needs to match as closely to the nearest value of the
grouping ahead of it. In other words, I need the sort to reverse itself
after each whole number break in the first column. Here is an example:
Raw data
Score Comp
20 5
20 9
20 0
19 12
19 4
19 3
19 1
18 8
18 7
18 7
How I want it to come out:
Score Comp
20 9
20 5
20 0
19 1
19 3
19 4
19 12
18 8
18 7
18 7
The problem is simply doing a double sort gets this:
20 9
20 5
20 0
19 12
19 4
19 3
19 1
18 8
18 7
18 7
Any suggestions? Thank you all very much for your help.
David
I would use a macro to do this. First sort by Score and Comp descending; then select and sort evey 2nd group in Comp Ascending.
The macro below assumes your data is an a region that includes A2 and is bounded by a blank row and column. It also assumes that there are no empty cells in column 1.
If the above is not the case, then you will need to provide a realistic example.
To enter this Macro (Sub), <alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.
To use this Macro (Sub), <alt-F8 opens the macro dialog box. Select the macro by name, and <RUN.
It will run on the active worksheet, so ensure that is the one your are viewing.
==============================================
Option Explicit
Sub SortAltCol2()
Dim r2Sort As Range
Dim rSubRange As Range
Dim c As Range, v As Variant
'Assume sort range is the region including A2
Set r2Sort = Range("a2").CurrentRegion
ActiveSheet.Sort.SortFields.Clear
r2Sort.Sort key1:=r2Sort.Columns(1), order1:=xlDescending, _
key2:=r2Sort.Columns(2), order2:=xlDescending, _
Header:=xlYes
'Now sort subranges of column 2
'Only need to do every other
Set c = r2Sort(2, 1)
Do Until c.Value = ""
NextChange c
Set rSubRange = c.Offset(columnoffset:=1)
NextChange c
Set rSubRange = rSubRange.Resize(rowsize:=c.Row - rSubRange.Row)
If Not Intersect(rSubRange, r2Sort) Is Nothing Then
rSubRange.Sort key1:=rSubRange.Columns(1), order1:=xlAscending, _
Header:=xlNo
End If
Loop
End Sub
Private Sub NextChange(c As Range)
Dim v As Variant
v = c.Value
Do Until v < c.Value
Set c = c(2)
If c.Value = "" Then Exit Do
Loop
End Sub
========================================
|