How to do this kind of sorting?

[Guest]

Referring to Excel General Question
Does anyone know how to perform this kind of sorting in excel?

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2

The above values are listed from cell A1 to A14
A1 has a higher priority than A2 on selection, and A14 has the lowest
priority on selection, because it located on the bottom of the list. I need
to select the top five numbers from the list without duplication, but the
distance between any two numbers must be bigger than / [equal to] the
smallest value from the list. On the other words, 2 is the smallest number
from the list,

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the first number is 13 for selection, and
[13]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the second number is 8, which 13-8=5 and is bigger than / equal to the
smallest number 2.
[13 8]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the third number cannot be 7, because abs(8-7)=1, which is less than the
smallest number 2, even through abs(13-7)=6, which is bigger than 2.
the next third number cannot be 7 again, then skip it for the next one.
the next third number cannot be 14, because abs(13-14)=1, which is less than
2.
....
the next third number is 3, abs(13-3)=10, abs(8-3)=5, which is bigger than 2
[13 8 3]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the next forth number is 23, which is OK, abs(13-23)=10, abs(8-23)=15, which
is bigger than 2
[13 8 3 23]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the next fifth number is 19, abs(13-19)=6, abs(8-19)=11, abs(23-19)=4,
abs(3-19)=16

[13 8 3 23 19] DONE, which values are stored in cell B1 to B5

Does any have any suggestion?
Thank you very much in advance
Eric

 

[NickHK]

Eric,
Not well tested, but may be this ;
Private Sub CommandButton2_Click()
Dim RetVals() As Long
Dim i As Long

RetVals = SortSpecial(Range("rngData").Value)

For i = LBound(RetVals) To UBound(RetVals)
Debug.Print RetVals(i)
Next

End Sub

Private Function SortSpecial(InData As Variant) As Long()
Dim OutArray() As Long
Dim LArray As Long
Dim UArray As Long
Dim MinValue As Long ' Single
Dim i As Long
Dim j As Long
Dim UniqueCount As Long

LArray = LBound(InData, 1)
UArray = UBound(InData, 1)

'Avoid many Redim Preserve, assume 100% required
ReDim OutArray(LArray To UArray)

'Get the Minimum value
MinValue = Application.Min(Range("rngData"))

'First value is always valid
OutArray(LArray) = InData(LArray, 1)
UniqueCount = LArray

For i = LArray + 1 To UArray
'make sure it is NOT the minimum value
If (InData(i, 1) <> MinValue) Then
'See if it meets the minimum difference requirement
For j = LArray To UniqueCount
If (Abs(InData(i, 1) - OutArray(j)) <= MinValue) Then
GoTo BreakOut
End If
Next

'See if we have that value already
For j = LArray To UniqueCount
If InData(i, 1) = OutArray(j) Then
GoTo BreakOut
End If
Next
UniqueCount = UniqueCount + 1
OutArray(UniqueCount) = InData(i, 1)
BreakOut:
End If
Next

'Redim to remove unused elements
ReDim Preserve OutArray(LArray To UniqueCount)
SortSpecial = OutArray()

End Function

NickHK

Referring to Excel General Question
Does anyone know how to perform this kind of sorting in excel?

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2

The above values are listed from cell A1 to A14
A1 has a higher priority than A2 on selection, and A14 has the lowest
priority on selection, because it located on the bottom of the list. I need
to select the top five numbers from the list without duplication, but the
distance between any two numbers must be bigger than / [equal to] the
smallest value from the list. On the other words, 2 is the smallest number
from the list,

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the first number is 13 for selection, and
[13]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the second number is 8, which 13-8=5 and is bigger than / equal to the
smallest number 2.
[13 8]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the third number cannot be 7, because abs(8-7)=1, which is less than the
smallest number 2, even through abs(13-7)=6, which is bigger than 2.
the next third number cannot be 7 again, then skip it for the next one.
the next third number cannot be 14, because abs(13-14)=1, which is less than
2.
...
the next third number is 3, abs(13-3)=10, abs(8-3)=5, which is bigger than 2
[13 8 3]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the next forth number is 23, which is OK, abs(13-23)=10, abs(8-23)=15, which
is bigger than 2
[13 8 3 23]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the next fifth number is 19, abs(13-19)=6, abs(8-19)=11, abs(23-19)=4,
abs(3-19)=16

[13 8 3 23 19] DONE, which values are stored in cell B1 to B5

Does any have any suggestion?
Thank you very much in advance
Eric

 

[NickHK]

Slight correction;

You should of course being using
'Get the Minimum value
MinValue = Application.Min(InData)

And I suppose you should delete
'First value is always valid
OutArray(LArray) = InData(LArray, 1)
UniqueCount = LArray

And change to
For i = LArray To UArray

And add error/array checking.

NickHK

Eric,
Not well tested, but may be this ;
Private Sub CommandButton2_Click()
Dim RetVals() As Long
Dim i As Long

RetVals = SortSpecial(Range("rngData").Value)

For i = LBound(RetVals) To UBound(RetVals)
Debug.Print RetVals(i)
Next

End Sub

Private Function SortSpecial(InData As Variant) As Long()
Dim OutArray() As Long
Dim LArray As Long
Dim UArray As Long
Dim MinValue As Long ' Single
Dim i As Long
Dim j As Long
Dim UniqueCount As Long

LArray = LBound(InData, 1)
UArray = UBound(InData, 1)

'Avoid many Redim Preserve, assume 100% required
ReDim OutArray(LArray To UArray)

'Get the Minimum value
MinValue = Application.Min(Range("rngData"))

'First value is always valid
OutArray(LArray) = InData(LArray, 1)
UniqueCount = LArray

For i = LArray + 1 To UArray
'make sure it is NOT the minimum value
If (InData(i, 1) <> MinValue) Then
'See if it meets the minimum difference requirement
For j = LArray To UniqueCount
If (Abs(InData(i, 1) - OutArray(j)) <= MinValue) Then
GoTo BreakOut
End If
Next

'See if we have that value already
For j = LArray To UniqueCount
If InData(i, 1) = OutArray(j) Then
GoTo BreakOut
End If
Next
UniqueCount = UniqueCount + 1
OutArray(UniqueCount) = InData(i, 1)
BreakOut:
End If
Next

'Redim to remove unused elements
ReDim Preserve OutArray(LArray To UniqueCount)
SortSpecial = OutArray()

End Function

NickHK

Referring to Excel General Question
Does anyone know how to perform this kind of sorting in excel?

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2

The above values are listed from cell A1 to A14
A1 has a higher priority than A2 on selection, and A14 has the lowest
priority on selection, because it located on the bottom of the list. I need
to select the top five numbers from the list without duplication, but the
distance between any two numbers must be bigger than / [equal to] the
smallest value from the list. On the other words, 2 is the smallest number
from the list,

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the first number is 13 for selection, and
[13]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the second number is 8, which 13-8=5 and is bigger than / equal to the
smallest number 2.
[13 8]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the third number cannot be 7, because abs(8-7)=1, which is less than the
smallest number 2, even through abs(13-7)=6, which is bigger than 2.
the next third number cannot be 7 again, then skip it for the next one.
the next third number cannot be 14, because abs(13-14)=1, which is less than
2.
...
the next third number is 3, abs(13-3)=10, abs(8-3)=5, which is bigger

than

2
[13 8 3]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the next forth number is 23, which is OK, abs(13-23)=10, abs(8-23)=15, which
is bigger than 2
[13 8 3 23]

13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
the next fifth number is 19, abs(13-19)=6, abs(8-19)=11, abs(23-19)=4,
abs(3-19)=16

[13 8 3 23 19] DONE, which values are stored in cell B1 to B5

Does any have any suggestion?
Thank you very much in advance
Eric

 

[kounoike]

If you don't mind using helper columns, try this.

put in B1
=A1
then put B1
{=IF(MIN(ABS(B$1:B1-A2))>=MIN(A$1:A$14),A2,A2+MAX(A$1:A$14))}
this is a array formula(Ctrl+Shift+enter), and copy B2 down to B14.

put C1
=IF(A1=B1,ROW(),"")
and copy C1 down to C14.

put D1
=IF(ISERROR(SMALL(C$1:C$14,ROW())),"",INDEX(A$1:A$14,SMALL(C$1:C$14,ROW())))
and copy D1 down to C14.

this will populate 13 8 3 23 19 in D15

keizi