Sort groups of 4 numbers

M

MaxTrax

Board Regular
Joined
Nov 18, 2014
Messages
91
Hi,

Asking for a formula to do this please.
Sort this: (Unique quads) in A1
115/125/140/145, 20/25/40/50, 105/110/120/135, 55/60/70/80, 5/10/15/30, 75/85/90/95,

To this (by the smallest leading number) in A2
5/10/15/30, 20/25/40/50, 55/60/70/80, 75/85/90/95, 105/110/120/135, 115/125/140/145

Thanks
 
Sort by date Sort by votes
There is, of course, a fairly small number of unique sets in the list of 23 (Post #19)
but that's fine.
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Does this UDF do what you want?
Code: 
[table="width: 500"]
[tr]
	[td]Function Pairs(HowMany As Long) As String
  
  Dim X As Long, Z As Long, Tmp As Variant, Temp1 As Variant, Temp2 As Variant
  Static OrigPrs As Variant
  
  Application.Volatile
  Randomize
  If IsEmpty(OrigPrs) Then OrigPrs = Split("5/10 5/20 5/30 10/20 10/40 20/30 20/50 30/60 40/50 40/70 50/60 " & _
                                           "50/80 60/90 70/80 70/100 80/90 80/110 90/120 100/110 100/130 110/120 " & _
                                           "110/140 120/150 130/140 130/160 140/150 140/170 150/180 160/170 160/190 " & _
                                           "170/180 170/200 180/210 190/200 190/220 200/210 200/230 210/240 220/230 " & _
                                           "220/250 230/240 230/260 240/270 250/260 250/280 260/270 260/290 270/300 " & _
                                           "280/290 280/310 290/300 290/320 300/330 310/320 310/340 320/330 320/350 330/360")
  
  For X = UBound(OrigPrs) To 0 Step -1
    Z = Int((X + 1) * Rnd)
    Tmp = OrigPrs(Z)
    OrigPrs(Z) = OrigPrs(X)
    OrigPrs(X) = Tmp
  Next
  
  Tmp = Split(Join(OrigPrs), " ", HowMany + 1)
  ReDim Preserve Tmp(UBound(Tmp) - 1)
  
  For X = 0 To UBound(Tmp)
    For Z = X To UBound(Tmp)
      If Val(Tmp(Z)) < Val(Tmp(X)) Then
        Temp1 = Tmp(X)
        Temp2 = Tmp(Z)
        Tmp(X) = Temp2
        Tmp(Z) = Temp1
      End If
    Next
  Next
  
  Pairs = Join(Tmp, ", ")
  
End Function[/td]
[/tr]
[/table]
 
Upvote 0
With regard to giving sets of unique sets of pairs. Then no.

A result from your test UDF. Pairs(9)
5/30, 5/10, 5/20, 20/30, 120/150, 160/170, 170/200, 220/230, 240/270 They are not unique sets.

With regard to giving sets of sorted sets of pairs. Then yes.


Of course with the Quads UDF the pairs list would be replaced by the quads list. Not sure if my terminology is correct.


Also I will give a result from the original pairs UDF
Pairs(9)
300/330, 90/120, 80/110, 280/290, 10/20, 130/140, 170/180, 230/260, 40/50
As you can see pairs are unique but not sorted.

<tbody>
</tbody>

<tbody>
</tbody>
 
Last edited:
Upvote 0
Just to let you know I'm back and see that I won't be able to provide a better solution for the pairs than Rick's.

Otherwise still wondering: how about the quads?

Edit: now I see the previous post, let me share my code. It may not be so well coded, but I think it gives the correct results.

Code: 
Function Pairs(howmany As Long) As String
  Static origprs As Variant
  
  Dim remprs As Variant, num As Variant, thesenums As Variant
  Dim s As String, tmp As String
  Dim i As Long, j As Long
  Dim sl
  
  ReDim sl(1 To 2, 1 To howmany)
  Application.Volatile
  Randomize
  If IsEmpty(origprs) Then origprs = Split("/5/10/ /5/20/ /5/30/ /10/20/ /10/40/ /20/30/ /20/50/ /30/60/ /40/50/ /40/70/ /50/60/" _
                                    & " /50/80/ /60/90/ /70/80/ /70/100/ /80/90/ /80/110/ /90/120/ /100/110/ /100/130/ /110/120/" _
                                    & " /110/140/ /120/150/ /130/140/ /130/160/ /140/150/ /140/170/ /150/180/ /160/170/ /160/190/" _
                                    & " /170/180/ /170/200/ /180/210/ /190/200/ /190/220/ /200/210/ /200/230/ /210/240/ /220/230/" _
                                    & " /220/250/ /230/240/ /230/260/ /240/270/ /250/260/ /250/280/ /260/270/ /260/290/ /270/300/" _
                                    & " /280/290/ /280/310/ /290/300/ /290/320/ /300/330/ /310/320/ /310/340/ /320/330/ /320/350/ /330/360/")
  remprs = origprs
  For i = 1 To howmany
    If UBound(remprs) = -1 Then
      Pairs = "Error"
      Exit Function
    End If
    s = remprs(Int(Rnd() * (UBound(remprs) + 1)))
    s = Mid(s, 2, Len(s) - 2)
    thesenums = Split(s, "/")
    For Each num In thesenums
      remprs = Filter(remprs, "/" & num & "/", False)
    Next num
    For j = i To 1 Step -1
        If j > 1 And sl(1, IIf(j = 1, 1, j - 1)) > CInt(thesenums(0)) Then
            sl(1, j) = sl(1, j - 1)
            sl(2, j) = sl(2, j - 1)
        Else
            sl(1, j) = CInt(thesenums(0))
            sl(2, j) = CInt(thesenums(1))
            Exit For
        End If
    Next j
  Next i
  For i = 1 To howmany
    tmp = tmp & ", " & sl(1, i) & "/" & sl(2, i)
  Next i
  Pairs = Mid(tmp, 3)
End Function
 
Last edited:
Upvote 0
MaxTrax said:
With regard to giving sets of unique sets of pairs. Then no.

A result from your test UDF. Pairs(9)
5/30, 5/10, 5/20, 20/30, 120/150, 160/170, 170/200, 220/230, 240/270 They are not unique sets.

<tbody>
Click to expand...

Okay, so it is not a pair that must be unique, every single number must be unique... is that correct?
 
Upvote 0
Yes Marcel. That's correct for the (new) pairs UDF :)

Example from your code: Pairs(9)

10/40, 30/60, 70/100, 170/200, 210/240, 220/230, 250/280, 260/270, 320/350

Each pair is unique
and
Result is sorted by the leading number.

Now for the Quads!!

Thank you
 
Upvote 0
MaxTrax said:
Yes Rick that is correct
Click to expand...
Here you go then, this should do what you want for the Pairs...
Code: 
[table="width: 500"]
[tr]
	[td]Function Pairs(HowMany As Long) As String
  
  Dim X As Long, Z As Long, P As Variant, OrigPrs As Variant, Nums As Variant, Temp1 As Variant, Temp2 As Variant
  
  Application.Volatile
  Randomize
  OrigPrs = Split("/5/10/ /5/20/ /5/30/ /10/20/ /10/40/ /20/30/ /20/50/ /30/60/ /40/50/ /40/70/ /50/60/ " & _
                  "/50/80/ /60/90 /70/80/ /70/100/ /80/90/ /80/110/ /90/120/ /100/110/ /100/130/ /110/120/ " & _
                  "/110/140/ /120/150/ /130/140/ /130/160/ /140/150/ /140/170/ /150/180/ /160/170/ /160/190/ " & _
                  "/170/180/ /170/200/ /180/210/ /190/200/ /190/220/ /200/210/ /200/230/ /210/240/ /220/230/ " & _
                  "/220/250/ /230/240/ /230/260/ /240/270/ /250/260/ /250/280/ /260/270/ /260/290/ /270/300/ " & _
                  "/280/290/ /280/310/ /290/300/ /290/320/ /300/330/ /310/320/ /310/340/ /320/330/ /320/350/ /330/360/")
  
  ReDim P(1 To HowMany)
  For X = 1 To HowMany
    P(X) = OrigPrs(Int((UBound(OrigPrs) + 1) * Rnd))
    Nums = Split(Mid(P(X), 2, Len(P(X)) - 2), "/")
    P(X) = Join(Nums, "/")
    For Z = 0 To UBound(Nums)
      OrigPrs = Filter(OrigPrs, "/" & Nums(Z) & "/", False)
    Next
  Next
  
  For X = 1 To UBound(P)
    For Z = X To UBound(P)
      If Val(P(Z)) < Val(P(X)) Then
        Temp1 = P(X)
        Temp2 = P(Z)
        P(X) = Temp2
        P(Z) = Temp1
      End If
    Next
  Next
  
  Pairs = Join(P, ", ")
  
End Function[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Thank you Rick. Now I'm spoiled. There is a slight prob though.....


Pairs(9)

5/10, 40/70, 60/9, 80/110, 130/160, 140/170, 190/200, 250/280, 260/270

Only for the 60/90 otherwise all good.

Thank you. I await the quads (said very sheepishly) :p

<tbody>
</tbody>


[Edit] I see it. Slash after the 90 missing. All good
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Inventory disposal plan
Replies
3
Views
32
Spaceballs_the_fanboy
S
V
  • Question
need help in formula
Replies
4
Views
469
VBABEGINER
V
V
  • Question
Daily datewise calculation with colour formatting
Replies
7
Views
76
Cubist
Cubist
K
  • Question
conditional formatting question
Replies
2
Views
224
kerm007
K
B
  • Locked
  • Question
Forecasting from two business sites on one output, is this possible?
Replies
2
Views
111
Fluff
Fluff

Forum statistics

Threads
1,216,014
Messages
6,128,280
Members
449,436
Latest member
blaineSpartan

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