G
Guest
A random number generator has delivered 50 sequences (rows) of numbers. Can
Excel list all the numbers sequentially (and just one time) from all the
rows?
Excel list all the numbers sequentially (and just one time) from all the
rows?
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
G
Guest
The only way to do it in the original list by itself would be to sort them
and immediately use UNDO to put them back into their original order.
You could add a helper column alongside the original list and just put
sequential numbers in it: 1 through 50. Sort by the random list to get them
listed in sequence from smallest/largest or largest/smallest. Then when you
want them back in the original random sequence, sort in ascending order by
the numbers in the helper column.
If the random numbers are generated by a formula within the cells using
RAND() or RANDBETWEEN(), all bets are off because the mere act of sorting
them causes a new list of random numbers to be generated ... they'll never be
sorted sequentially except by pure random chance.
and immediately use UNDO to put them back into their original order.
You could add a helper column alongside the original list and just put
sequential numbers in it: 1 through 50. Sort by the random list to get them
listed in sequence from smallest/largest or largest/smallest. Then when you
want them back in the original random sequence, sort in ascending order by
the numbers in the helper column.
If the random numbers are generated by a formula within the cells using
RAND() or RANDBETWEEN(), all bets are off because the mere act of sorting
them causes a new list of random numbers to be generated ... they'll never be
sorted sequentially except by pure random chance.
G
Guest
Either I didn't ask my question correctly or I don't understand your reply.
Here's a small example of what I'm looking for:
row 1) 2, 5, 17, 39, 57, 102, 114
row 2) 2, 12, 17, 44, 104, 114, 117
row 3) 2, 12, 44, 57, 102, 114, 117
LIST: 2, 5, 12, 17, 39, 44, 57, 102, 104, 114, 117
I want to make one-long-list of all of the numbers from all the rows,
without repeating any numbers
Thanks again,
Steve
Here's a small example of what I'm looking for:
row 1) 2, 5, 17, 39, 57, 102, 114
row 2) 2, 12, 17, 44, 104, 114, 117
row 3) 2, 12, 44, 57, 102, 114, 117
LIST: 2, 5, 12, 17, 39, 44, 57, 102, 104, 114, 117
I want to make one-long-list of all of the numbers from all the rows,
without repeating any numbers
Thanks again,
Steve
G
Guest
Steve,
I misunderstood - I though you already had a long list of (unique) numbers,
they just were not sorted.
Here's code that will do the job - it will put the results on a separate
sheet that it will create in the workbook. If you reuse the routine within
the same workbook, it will erase previous results on that same added sheet,
so if you need to keep them, rename the sheet before running the code again.
To put the code into your workbook, open the workbook and press [Alt]+[F11]
to enter the VB Editor. Choose Insert | Module from the VBE menu and copy
and paste the code into it. Close the VBE, choose the sheet with your random
numbers on it and then use Tools | Macro | Macros and choose the
SortAndFilter macro from the list and click the [Run] button.
Since you showed the output as a row, I set it up to provide that, but put a
comment in the code to tell you how to get the output as a column instead, if
you need that.
Sub SortAndFilter()
'change these two Const values as needed
'if your data does not start at A1
Const firstCol = "A"
Const firstRow = 1
Dim lastRow As Long
Dim lastCol As Long
Dim unique() As Integer
Dim srcSheet As String
Dim destSheet As String
Dim baseCell As Range
Dim rOffset As Long
Dim cOffset As Long
Dim uPointer As Long
Dim dupeFlag As Boolean
'determine last row used
'assumes col A has longest list
lastRow = Range(firstCol & Rows.Count).End(xlUp).Row
'determine last column used
'assumes row 1 has most used columns
lastCol = Range(firstCol & "1").Offset(0, Columns.Count - 1). _
End(xlToLeft).Column
'initialize array
ReDim unique(1 To 1)
'read in unique values
Set baseCell = Range(firstCol & firstRow)
For rOffset = 1 To lastRow
For cOffset = 1 To lastCol
If IsNumeric(baseCell.Offset(rOffset - 1, _
cOffset - 1)) Then
dupeFlag = False
For uPointer = LBound(unique) To UBound(unique)
If baseCell.Offset(rOffset - 1, cOffset - 1) = _
unique(uPointer) Then
dupeFlag = True
Exit For ' quit looking, found match
End If
Next ' uPointer end
If Not dupeFlag Then
'new, unique value, add to array
unique(UBound(unique)) = _
baseCell.Offset(rOffset - 1, cOffset - 1)
ReDim Preserve unique(1 To UBound(unique) + 1)
End If
End If ' check for numeric content of cell
Next ' cOffset end
Next ' rOffset end
'array unique will always have last element unused
'so get rid of it
If UBound(unique) > 1 Then
ReDim Preserve unique(1 To UBound(unique) - 1)
QuickSort unique(), LBound(unique), UBound(unique)
End If
On Error Resume Next
Worksheets("SortedUniqueEntries").Activate
If Err <> 0 Then
Worksheets.Add
ActiveSheet.Name = "SortedUniqueEntries"
Err.Clear
Else
ActiveSheet.Cells.ClearContents
End If
On Error GoTo 0
Set baseCell = ActiveSheet.Range("A1")
For cOffset = 0 To UBound(unique) - 1
'if you'd rather they be in a column
'change the next statement to:
' baseCell.Offset(cOffset, 0) = unique(cOffset + 1)
baseCell.Offset(0, cOffset) = unique(cOffset + 1)
Next
End Sub
Private Sub QuickSort(list() As Integer, _
ByVal min As Long, ByVal max As Long)
' Quicksort() from:
' http://vb-helper.com/howto_quicksort.html
'an implementation of a Quick Sort
'change the List() type to the type of data to be sorted
'
Dim med_value As Long
Dim hi As Long
Dim lo As Long
Dim i As Long
' If min >= max, the list contains 0 or 1 items so it
' is sorted.
If min >= max Then
Exit Sub
End If
' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)
' Swap it to the front.
list(i) = list(min)
lo = min
hi = max
Do
' Look down from hi for a value < med_value.
Do While list(hi) >= med_value
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
list(lo) = med_value
Exit Do
End If
' Swap the lo and hi values.
list(lo) = list(hi)
' Look up from lo for a value >= med_value.
lo = lo + 1
Do While list(lo) < med_value
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
lo = hi
list(hi) = med_value
Exit Do
End If
' Swap the lo and hi values.
list(hi) = list(lo)
Loop
' Sort the two sublists.
QuickSort list(), min, lo - 1
QuickSort list(), lo + 1, max
End Sub
I misunderstood - I though you already had a long list of (unique) numbers,
they just were not sorted.
Here's code that will do the job - it will put the results on a separate
sheet that it will create in the workbook. If you reuse the routine within
the same workbook, it will erase previous results on that same added sheet,
so if you need to keep them, rename the sheet before running the code again.
To put the code into your workbook, open the workbook and press [Alt]+[F11]
to enter the VB Editor. Choose Insert | Module from the VBE menu and copy
and paste the code into it. Close the VBE, choose the sheet with your random
numbers on it and then use Tools | Macro | Macros and choose the
SortAndFilter macro from the list and click the [Run] button.
Since you showed the output as a row, I set it up to provide that, but put a
comment in the code to tell you how to get the output as a column instead, if
you need that.
Sub SortAndFilter()
'change these two Const values as needed
'if your data does not start at A1
Const firstCol = "A"
Const firstRow = 1
Dim lastRow As Long
Dim lastCol As Long
Dim unique() As Integer
Dim srcSheet As String
Dim destSheet As String
Dim baseCell As Range
Dim rOffset As Long
Dim cOffset As Long
Dim uPointer As Long
Dim dupeFlag As Boolean
'determine last row used
'assumes col A has longest list
lastRow = Range(firstCol & Rows.Count).End(xlUp).Row
'determine last column used
'assumes row 1 has most used columns
lastCol = Range(firstCol & "1").Offset(0, Columns.Count - 1). _
End(xlToLeft).Column
'initialize array
ReDim unique(1 To 1)
'read in unique values
Set baseCell = Range(firstCol & firstRow)
For rOffset = 1 To lastRow
For cOffset = 1 To lastCol
If IsNumeric(baseCell.Offset(rOffset - 1, _
cOffset - 1)) Then
dupeFlag = False
For uPointer = LBound(unique) To UBound(unique)
If baseCell.Offset(rOffset - 1, cOffset - 1) = _
unique(uPointer) Then
dupeFlag = True
Exit For ' quit looking, found match
End If
Next ' uPointer end
If Not dupeFlag Then
'new, unique value, add to array
unique(UBound(unique)) = _
baseCell.Offset(rOffset - 1, cOffset - 1)
ReDim Preserve unique(1 To UBound(unique) + 1)
End If
End If ' check for numeric content of cell
Next ' cOffset end
Next ' rOffset end
'array unique will always have last element unused
'so get rid of it
If UBound(unique) > 1 Then
ReDim Preserve unique(1 To UBound(unique) - 1)
QuickSort unique(), LBound(unique), UBound(unique)
End If
On Error Resume Next
Worksheets("SortedUniqueEntries").Activate
If Err <> 0 Then
Worksheets.Add
ActiveSheet.Name = "SortedUniqueEntries"
Err.Clear
Else
ActiveSheet.Cells.ClearContents
End If
On Error GoTo 0
Set baseCell = ActiveSheet.Range("A1")
For cOffset = 0 To UBound(unique) - 1
'if you'd rather they be in a column
'change the next statement to:
' baseCell.Offset(cOffset, 0) = unique(cOffset + 1)
baseCell.Offset(0, cOffset) = unique(cOffset + 1)
Next
End Sub
Private Sub QuickSort(list() As Integer, _
ByVal min As Long, ByVal max As Long)
' Quicksort() from:
' http://vb-helper.com/howto_quicksort.html
'an implementation of a Quick Sort
'change the List() type to the type of data to be sorted
'
Dim med_value As Long
Dim hi As Long
Dim lo As Long
Dim i As Long
' If min >= max, the list contains 0 or 1 items so it
' is sorted.
If min >= max Then
Exit Sub
End If
' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)
' Swap it to the front.
list(i) = list(min)
lo = min
hi = max
Do
' Look down from hi for a value < med_value.
Do While list(hi) >= med_value
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
list(lo) = med_value
Exit Do
End If
' Swap the lo and hi values.
list(lo) = list(hi)
' Look up from lo for a value >= med_value.
lo = lo + 1
Do While list(lo) < med_value
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
lo = hi
list(hi) = med_value
Exit Do
End If
' Swap the lo and hi values.
list(hi) = list(lo)
Loop
' Sort the two sublists.
QuickSort list(), min, lo - 1
QuickSort list(), lo + 1, max
End Sub
G
Guest
You are truly a wizard! It worked perfectly. Thank you very much!!
I could spend more of your valuable time with my basic questions, but I know
that you have others to help. So, I'll ask just one more question:
Is there a way for Excel to take this newly created 'unique number list' and
create a graph weighting each number (showing the times each number repeated)?
From my example:
x x
x x x x x x x x
x x x x x x x x x x x
2 5 12 17 39 44 57 102 104 114 117
Thanks again,
Steve
I could spend more of your valuable time with my basic questions, but I know
that you have others to help. So, I'll ask just one more question:
Is there a way for Excel to take this newly created 'unique number list' and
create a graph weighting each number (showing the times each number repeated)?
From my example:
x x
x x x x x x x x
x x x x x x x x x x x
2 5 12 17 39 44 57 102 104 114 117
Thanks again,
Steve
JLatham said:Steve,
I misunderstood - I though you already had a long list of (unique) numbers,
they just were not sorted.
Here's code that will do the job - it will put the results on a separate
sheet that it will create in the workbook. If you reuse the routine within
the same workbook, it will erase previous results on that same added sheet,
so if you need to keep them, rename the sheet before running the code again.
To put the code into your workbook, open the workbook and press [Alt]+[F11]
to enter the VB Editor. Choose Insert | Module from the VBE menu and copy
and paste the code into it. Close the VBE, choose the sheet with your random
numbers on it and then use Tools | Macro | Macros and choose the
SortAndFilter macro from the list and click the [Run] button.
Since you showed the output as a row, I set it up to provide that, but put a
comment in the code to tell you how to get the output as a column instead, if
you need that.
Sub SortAndFilter()
'change these two Const values as needed
'if your data does not start at A1
Const firstCol = "A"
Const firstRow = 1
Dim lastRow As Long
Dim lastCol As Long
Dim unique() As Integer
Dim srcSheet As String
Dim destSheet As String
Dim baseCell As Range
Dim rOffset As Long
Dim cOffset As Long
Dim uPointer As Long
Dim dupeFlag As Boolean
'determine last row used
'assumes col A has longest list
lastRow = Range(firstCol & Rows.Count).End(xlUp).Row
'determine last column used
'assumes row 1 has most used columns
lastCol = Range(firstCol & "1").Offset(0, Columns.Count - 1). _
End(xlToLeft).Column
'initialize array
ReDim unique(1 To 1)
'read in unique values
Set baseCell = Range(firstCol & firstRow)
For rOffset = 1 To lastRow
For cOffset = 1 To lastCol
If IsNumeric(baseCell.Offset(rOffset - 1, _
cOffset - 1)) Then
dupeFlag = False
For uPointer = LBound(unique) To UBound(unique)
If baseCell.Offset(rOffset - 1, cOffset - 1) = _
unique(uPointer) Then
dupeFlag = True
Exit For ' quit looking, found match
End If
Next ' uPointer end
If Not dupeFlag Then
'new, unique value, add to array
unique(UBound(unique)) = _
baseCell.Offset(rOffset - 1, cOffset - 1)
ReDim Preserve unique(1 To UBound(unique) + 1)
End If
End If ' check for numeric content of cell
Next ' cOffset end
Next ' rOffset end
'array unique will always have last element unused
'so get rid of it
If UBound(unique) > 1 Then
ReDim Preserve unique(1 To UBound(unique) - 1)
QuickSort unique(), LBound(unique), UBound(unique)
End If
On Error Resume Next
Worksheets("SortedUniqueEntries").Activate
If Err <> 0 Then
Worksheets.Add
ActiveSheet.Name = "SortedUniqueEntries"
Err.Clear
Else
ActiveSheet.Cells.ClearContents
End If
On Error GoTo 0
Set baseCell = ActiveSheet.Range("A1")
For cOffset = 0 To UBound(unique) - 1
'if you'd rather they be in a column
'change the next statement to:
' baseCell.Offset(cOffset, 0) = unique(cOffset + 1)
baseCell.Offset(0, cOffset) = unique(cOffset + 1)
Next
End Sub
Private Sub QuickSort(list() As Integer, _
ByVal min As Long, ByVal max As Long)
' Quicksort() from:
' http://vb-helper.com/howto_quicksort.html
'an implementation of a Quick Sort
'change the List() type to the type of data to be sorted
'
Dim med_value As Long
Dim hi As Long
Dim lo As Long
Dim i As Long
' If min >= max, the list contains 0 or 1 items so it
' is sorted.
If min >= max Then
Exit Sub
End If
' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)
' Swap it to the front.
list(i) = list(min)
lo = min
hi = max
Do
' Look down from hi for a value < med_value.
Do While list(hi) >= med_value
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
list(lo) = med_value
Exit Do
End If
' Swap the lo and hi values.
list(lo) = list(hi)
' Look up from lo for a value >= med_value.
lo = lo + 1
Do While list(lo) < med_value
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
lo = hi
list(hi) = med_value
Exit Do
End If
' Swap the lo and hi values.
list(hi) = list(lo)
Loop
' Sort the two sublists.
QuickSort list(), min, lo - 1
QuickSort list(), lo + 1, max
End Sub
Steve said:Either I didn't ask my question correctly or I don't understand your reply.
Here's a small example of what I'm looking for:
row 1) 2, 5, 17, 39, 57, 102, 114
row 2) 2, 12, 17, 44, 104, 114, 117
row 3) 2, 12, 44, 57, 102, 114, 117
LIST: 2, 5, 12, 17, 39, 44, 57, 102, 104, 114, 117
I want to make one-long-list of all of the numbers from all the rows,
without repeating any numbers
Thanks again,
Steve
G
Guest
Sorry, my graph example didn't look right on the post. It should show:
appeared:-3--1---2---2---1----2---2----2-----1-----3-----2--times
list:-------2--5--12--17--39--44--57--102--104--114--117
-----------x-------------------------------------------x
-----------x------x----x--------x----x----x-----------x-----x
-----------x--x---x----x---x----x----x----x-----x-----x-----x
-----------2--5--12--17--39--44--57--102--104--114--117
Thanks again,
Steve
--------------------------------------------
appeared:-3--1---2---2---1----2---2----2-----1-----3-----2--times
list:-------2--5--12--17--39--44--57--102--104--114--117
-----------x-------------------------------------------x
-----------x------x----x--------x----x----x-----------x-----x
-----------x--x---x----x---x----x----x----x-----x-----x-----x
-----------2--5--12--17--39--44--57--102--104--114--117
Thanks again,
Steve
--------------------------------------------
JLatham said:Steve,
I misunderstood - I though you already had a long list of (unique) numbers,
they just were not sorted.
Here's code that will do the job - it will put the results on a separate
sheet that it will create in the workbook. If you reuse the routine within
the same workbook, it will erase previous results on that same added sheet,
so if you need to keep them, rename the sheet before running the code again.
To put the code into your workbook, open the workbook and press [Alt]+[F11]
to enter the VB Editor. Choose Insert | Module from the VBE menu and copy
and paste the code into it. Close the VBE, choose the sheet with your random
numbers on it and then use Tools | Macro | Macros and choose the
SortAndFilter macro from the list and click the [Run] button.
Since you showed the output as a row, I set it up to provide that, but put a
comment in the code to tell you how to get the output as a column instead, if
you need that.
Sub SortAndFilter()
'change these two Const values as needed
'if your data does not start at A1
Const firstCol = "A"
Const firstRow = 1
Dim lastRow As Long
Dim lastCol As Long
Dim unique() As Integer
Dim srcSheet As String
Dim destSheet As String
Dim baseCell As Range
Dim rOffset As Long
Dim cOffset As Long
Dim uPointer As Long
Dim dupeFlag As Boolean
'determine last row used
'assumes col A has longest list
lastRow = Range(firstCol & Rows.Count).End(xlUp).Row
'determine last column used
'assumes row 1 has most used columns
lastCol = Range(firstCol & "1").Offset(0, Columns.Count - 1). _
End(xlToLeft).Column
'initialize array
ReDim unique(1 To 1)
'read in unique values
Set baseCell = Range(firstCol & firstRow)
For rOffset = 1 To lastRow
For cOffset = 1 To lastCol
If IsNumeric(baseCell.Offset(rOffset - 1, _
cOffset - 1)) Then
dupeFlag = False
For uPointer = LBound(unique) To UBound(unique)
If baseCell.Offset(rOffset - 1, cOffset - 1) = _
unique(uPointer) Then
dupeFlag = True
Exit For ' quit looking, found match
End If
Next ' uPointer end
If Not dupeFlag Then
'new, unique value, add to array
unique(UBound(unique)) = _
baseCell.Offset(rOffset - 1, cOffset - 1)
ReDim Preserve unique(1 To UBound(unique) + 1)
End If
End If ' check for numeric content of cell
Next ' cOffset end
Next ' rOffset end
'array unique will always have last element unused
'so get rid of it
If UBound(unique) > 1 Then
ReDim Preserve unique(1 To UBound(unique) - 1)
QuickSort unique(), LBound(unique), UBound(unique)
End If
On Error Resume Next
Worksheets("SortedUniqueEntries").Activate
If Err <> 0 Then
Worksheets.Add
ActiveSheet.Name = "SortedUniqueEntries"
Err.Clear
Else
ActiveSheet.Cells.ClearContents
End If
On Error GoTo 0
Set baseCell = ActiveSheet.Range("A1")
For cOffset = 0 To UBound(unique) - 1
'if you'd rather they be in a column
'change the next statement to:
' baseCell.Offset(cOffset, 0) = unique(cOffset + 1)
baseCell.Offset(0, cOffset) = unique(cOffset + 1)
Next
End Sub
Private Sub QuickSort(list() As Integer, _
ByVal min As Long, ByVal max As Long)
' Quicksort() from:
' http://vb-helper.com/howto_quicksort.html
'an implementation of a Quick Sort
'change the List() type to the type of data to be sorted
'
Dim med_value As Long
Dim hi As Long
Dim lo As Long
Dim i As Long
' If min >= max, the list contains 0 or 1 items so it
' is sorted.
If min >= max Then
Exit Sub
End If
' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)
' Swap it to the front.
list(i) = list(min)
lo = min
hi = max
Do
' Look down from hi for a value < med_value.
Do While list(hi) >= med_value
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
list(lo) = med_value
Exit Do
End If
' Swap the lo and hi values.
list(lo) = list(hi)
' Look up from lo for a value >= med_value.
lo = lo + 1
Do While list(lo) < med_value
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
lo = hi
list(hi) = med_value
Exit Do
End If
' Swap the lo and hi values.
list(hi) = list(lo)
Loop
' Sort the two sublists.
QuickSort list(), min, lo - 1
QuickSort list(), lo + 1, max
End Sub
Steve said:Either I didn't ask my question correctly or I don't understand your reply.
Here's a small example of what I'm looking for:
row 1) 2, 5, 17, 39, 57, 102, 114
row 2) 2, 12, 17, 44, 104, 114, 117
row 3) 2, 12, 44, 57, 102, 114, 117
LIST: 2, 5, 12, 17, 39, 44, 57, 102, 104, 114, 117
I want to make one-long-list of all of the numbers from all the rows,
without repeating any numbers
Thanks again,
Steve
:
The only way to do it in the original list by itself would be to sort them
and immediately use UNDO to put them back into their original order.
You could add a helper column alongside the original list and just put
sequential numbers in it: 1 through 50. Sort by the random list to get them
listed in sequence from smallest/largest or largest/smallest. Then when you
want them back in the original random sequence, sort in ascending order by
the numbers in the helper column.
If the random numbers are generated by a formula within the cells using
RAND() or RANDBETWEEN(), all bets are off because the mere act of sorting
them causes a new list of random numbers to be generated ... they'll never be
sorted sequentially except by pure random chance.
:
A random number generator has delivered 50 sequences (rows) of numbers. Can
Excel list all the numbers sequentially (and just one time) from all the
rows?
G
Guest
Replace the SortAndFilter routine with the code below - be sure and leave the
QuickSort code in place. This will do as you've shown, but instead of 'x' in
the entries, the count of occurrences will be in it (easy to find and change
if you don't like it) and the cells you show with x in them will be shaded
red. If red isn't your color, then you'll find a whole list of 55 other
values you can use instead of 3 here:
http://www.mvps.org/dmcritchie/excel/colors.htm#colorindex
Sub SortAndFilter()
'change these two Const values as needed
'if your data does not start at A1
Const firstCol = "A"
Const firstRow = 1
Dim lastRow As Long
Dim lastCol As Long
Dim unique() As Integer
Dim hitCount() As Integer
Dim srcSheet As String
Dim destSheet As String
Dim baseCell As Range
Dim rOffset As Long
Dim cOffset As Long
Dim uPointer As Long
Dim dupeFlag As Boolean
Dim maxCount As Single
'determine last row used
'assumes col A has longest list
lastRow = Range(firstCol & Rows.Count).End(xlUp).Row
'determine last column used
'assumes row 1 has most used columns
lastCol = Range(firstCol & "1").Offset(0, _
Columns.Count - 1). _
End(xlToLeft).Column
'initialize array
ReDim unique(1 To 1)
'read in unique values
Set baseCell = Range(firstCol & firstRow)
For rOffset = 1 To lastRow
For cOffset = 1 To lastCol
If IsNumeric(baseCell.Offset(rOffset - 1, _
cOffset - 1)) Then
dupeFlag = False
For uPointer = LBound(unique) To UBound(unique)
If baseCell.Offset(rOffset - 1, cOffset - 1) = _
unique(uPointer) Then
dupeFlag = True
Exit For ' quit looking, found match
End If
Next ' uPointer end
If Not dupeFlag Then
'new, unique value, add to array
unique(UBound(unique)) = _
baseCell.Offset(rOffset - 1, cOffset - 1)
ReDim Preserve unique(1 To UBound(unique) + 1)
End If
End If ' check for numeric content of cell
Next ' cOffset end
Next ' rOffset end
'array unique will always have last element unused
'so get rid of it
If UBound(unique) > 1 Then
ReDim Preserve unique(1 To UBound(unique) - 1)
QuickSort unique(), LBound(unique), UBound(unique)
End If
'with the list sorted, we need to go back through the
'source data and count the occurrences of each unique value
ReDim hitCount(1 To 2, LBound(unique) To UBound(unique))
For uPointer = LBound(unique) To UBound(unique)
hitCount(1, uPointer) = unique(uPointer)
hitCount(2, uPointer) = 0
Next
maxCount = 0 ' initialize
For rOffset = 1 To lastRow
For cOffset = 1 To lastCol
If IsNumeric(baseCell.Offset(rOffset - 1, _
cOffset - 1)) Then
For uPointer = LBound(unique) To UBound(unique)
If baseCell.Offset(rOffset - 1, cOffset - 1) = _
hitCount(1, uPointer) Then
hitCount(2, uPointer) = hitCount(2, uPointer) + 1
If hitCount(2, uPointer) > maxCount Then
maxCount = hitCount(2, uPointer)
End If
End If
Next ' uPointer end
End If ' check for numeric content of cell
Next ' cOffset end
Next ' rOffset end
On Error Resume Next
Worksheets("SortedUniqueEntries").Activate
If Err <> 0 Then
Worksheets.Add
ActiveSheet.Name = "SortedUniqueEntries"
Err.Clear
Else
'same as Edit | Clear | All
ActiveSheet.Cells.Clear
End If
On Error GoTo 0
Set baseCell = ActiveSheet.Range("A" & maxCount + 1)
For cOffset = 0 To UBound(hitCount, 2) - 1
baseCell.Offset(0, cOffset) = hitCount(1, cOffset + 1)
For rOffset = 1 To hitCount(2, cOffset + 1)
With baseCell.Offset(-rOffset, cOffset)
.Value = hitCount(2, cOffset + 1)
.Interior.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
Next
Next
End Sub
QuickSort code in place. This will do as you've shown, but instead of 'x' in
the entries, the count of occurrences will be in it (easy to find and change
if you don't like it) and the cells you show with x in them will be shaded
red. If red isn't your color, then you'll find a whole list of 55 other
values you can use instead of 3 here:
http://www.mvps.org/dmcritchie/excel/colors.htm#colorindex
Sub SortAndFilter()
'change these two Const values as needed
'if your data does not start at A1
Const firstCol = "A"
Const firstRow = 1
Dim lastRow As Long
Dim lastCol As Long
Dim unique() As Integer
Dim hitCount() As Integer
Dim srcSheet As String
Dim destSheet As String
Dim baseCell As Range
Dim rOffset As Long
Dim cOffset As Long
Dim uPointer As Long
Dim dupeFlag As Boolean
Dim maxCount As Single
'determine last row used
'assumes col A has longest list
lastRow = Range(firstCol & Rows.Count).End(xlUp).Row
'determine last column used
'assumes row 1 has most used columns
lastCol = Range(firstCol & "1").Offset(0, _
Columns.Count - 1). _
End(xlToLeft).Column
'initialize array
ReDim unique(1 To 1)
'read in unique values
Set baseCell = Range(firstCol & firstRow)
For rOffset = 1 To lastRow
For cOffset = 1 To lastCol
If IsNumeric(baseCell.Offset(rOffset - 1, _
cOffset - 1)) Then
dupeFlag = False
For uPointer = LBound(unique) To UBound(unique)
If baseCell.Offset(rOffset - 1, cOffset - 1) = _
unique(uPointer) Then
dupeFlag = True
Exit For ' quit looking, found match
End If
Next ' uPointer end
If Not dupeFlag Then
'new, unique value, add to array
unique(UBound(unique)) = _
baseCell.Offset(rOffset - 1, cOffset - 1)
ReDim Preserve unique(1 To UBound(unique) + 1)
End If
End If ' check for numeric content of cell
Next ' cOffset end
Next ' rOffset end
'array unique will always have last element unused
'so get rid of it
If UBound(unique) > 1 Then
ReDim Preserve unique(1 To UBound(unique) - 1)
QuickSort unique(), LBound(unique), UBound(unique)
End If
'with the list sorted, we need to go back through the
'source data and count the occurrences of each unique value
ReDim hitCount(1 To 2, LBound(unique) To UBound(unique))
For uPointer = LBound(unique) To UBound(unique)
hitCount(1, uPointer) = unique(uPointer)
hitCount(2, uPointer) = 0
Next
maxCount = 0 ' initialize
For rOffset = 1 To lastRow
For cOffset = 1 To lastCol
If IsNumeric(baseCell.Offset(rOffset - 1, _
cOffset - 1)) Then
For uPointer = LBound(unique) To UBound(unique)
If baseCell.Offset(rOffset - 1, cOffset - 1) = _
hitCount(1, uPointer) Then
hitCount(2, uPointer) = hitCount(2, uPointer) + 1
If hitCount(2, uPointer) > maxCount Then
maxCount = hitCount(2, uPointer)
End If
End If
Next ' uPointer end
End If ' check for numeric content of cell
Next ' cOffset end
Next ' rOffset end
On Error Resume Next
Worksheets("SortedUniqueEntries").Activate
If Err <> 0 Then
Worksheets.Add
ActiveSheet.Name = "SortedUniqueEntries"
Err.Clear
Else
'same as Edit | Clear | All
ActiveSheet.Cells.Clear
End If
On Error GoTo 0
Set baseCell = ActiveSheet.Range("A" & maxCount + 1)
For cOffset = 0 To UBound(hitCount, 2) - 1
baseCell.Offset(0, cOffset) = hitCount(1, cOffset + 1)
For rOffset = 1 To hitCount(2, cOffset + 1)
With baseCell.Offset(-rOffset, cOffset)
.Value = hitCount(2, cOffset + 1)
.Interior.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
Next
Next
End Sub
Steve said:Sorry, my graph example didn't look right on the post. It should show:
appeared:-3--1---2---2---1----2---2----2-----1-----3-----2--times
list:-------2--5--12--17--39--44--57--102--104--114--117
-----------x-------------------------------------------x
-----------x------x----x--------x----x----x-----------x-----x
-----------x--x---x----x---x----x----x----x-----x-----x-----x
-----------2--5--12--17--39--44--57--102--104--114--117
Thanks again,
Steve
--------------------------------------------JLatham said:Steve,
I misunderstood - I though you already had a long list of (unique) numbers,
they just were not sorted.
Here's code that will do the job - it will put the results on a separate
sheet that it will create in the workbook. If you reuse the routine within
the same workbook, it will erase previous results on that same added sheet,
so if you need to keep them, rename the sheet before running the code again.
To put the code into your workbook, open the workbook and press [Alt]+[F11]
to enter the VB Editor. Choose Insert | Module from the VBE menu and copy
and paste the code into it. Close the VBE, choose the sheet with your random
numbers on it and then use Tools | Macro | Macros and choose the
SortAndFilter macro from the list and click the [Run] button.
Since you showed the output as a row, I set it up to provide that, but put a
comment in the code to tell you how to get the output as a column instead, if
you need that.
Sub SortAndFilter()
'change these two Const values as needed
'if your data does not start at A1
Const firstCol = "A"
Const firstRow = 1
Dim lastRow As Long
Dim lastCol As Long
Dim unique() As Integer
Dim srcSheet As String
Dim destSheet As String
Dim baseCell As Range
Dim rOffset As Long
Dim cOffset As Long
Dim uPointer As Long
Dim dupeFlag As Boolean
'determine last row used
'assumes col A has longest list
lastRow = Range(firstCol & Rows.Count).End(xlUp).Row
'determine last column used
'assumes row 1 has most used columns
lastCol = Range(firstCol & "1").Offset(0, Columns.Count - 1). _
End(xlToLeft).Column
'initialize array
ReDim unique(1 To 1)
'read in unique values
Set baseCell = Range(firstCol & firstRow)
For rOffset = 1 To lastRow
For cOffset = 1 To lastCol
If IsNumeric(baseCell.Offset(rOffset - 1, _
cOffset - 1)) Then
dupeFlag = False
For uPointer = LBound(unique) To UBound(unique)
If baseCell.Offset(rOffset - 1, cOffset - 1) = _
unique(uPointer) Then
dupeFlag = True
Exit For ' quit looking, found match
End If
Next ' uPointer end
If Not dupeFlag Then
'new, unique value, add to array
unique(UBound(unique)) = _
baseCell.Offset(rOffset - 1, cOffset - 1)
ReDim Preserve unique(1 To UBound(unique) + 1)
End If
End If ' check for numeric content of cell
Next ' cOffset end
Next ' rOffset end
'array unique will always have last element unused
'so get rid of it
If UBound(unique) > 1 Then
ReDim Preserve unique(1 To UBound(unique) - 1)
QuickSort unique(), LBound(unique), UBound(unique)
End If
On Error Resume Next
Worksheets("SortedUniqueEntries").Activate
If Err <> 0 Then
Worksheets.Add
ActiveSheet.Name = "SortedUniqueEntries"
Err.Clear
Else
ActiveSheet.Cells.ClearContents
End If
On Error GoTo 0
Set baseCell = ActiveSheet.Range("A1")
For cOffset = 0 To UBound(unique) - 1
'if you'd rather they be in a column
'change the next statement to:
' baseCell.Offset(cOffset, 0) = unique(cOffset + 1)
baseCell.Offset(0, cOffset) = unique(cOffset + 1)
Next
End Sub
Private Sub QuickSort(list() As Integer, _
ByVal min As Long, ByVal max As Long)
' Quicksort() from:
' http://vb-helper.com/howto_quicksort.html
'an implementation of a Quick Sort
'change the List() type to the type of data to be sorted
'
Dim med_value As Long
Dim hi As Long
Dim lo As Long
Dim i As Long
' If min >= max, the list contains 0 or 1 items so it
' is sorted.
If min >= max Then
Exit Sub
End If
' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)
' Swap it to the front.
list(i) = list(min)
lo = min
hi = max
Do
' Look down from hi for a value < med_value.
Do While list(hi) >= med_value
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
list(lo) = med_value
Exit Do
End If
' Swap the lo and hi values.
list(lo) = list(hi)
' Look up from lo for a value >= med_value.
lo = lo + 1
Do While list(lo) < med_value
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
lo = hi
list(hi) = med_value
Exit Do
End If
' Swap the lo and hi values.
list(hi) = list(lo)
Loop
' Sort the two sublists.
QuickSort list(), min, lo - 1
QuickSort list(), lo + 1, max
End Sub
:
Either I didn't ask my question correctly or I don't understand your reply.
Here's a small example of what I'm looking for:
row 1) 2, 5, 17, 39, 57, 102, 114
row 2) 2, 12, 17, 44, 104, 114, 117
row 3) 2, 12, 44, 57, 102, 114, 117
LIST: 2, 5, 12, 17, 39, 44, 57, 102, 104, 114, 117
I want to make one-long-list of all of the numbers from all the rows,
without repeating any numbers
Thanks again,
Steve
:
The only way to do it in the original list by itself would be to sort them
and immediately use UNDO to put them back into their original order.
You could add a helper column alongside the original list and just put
sequential numbers in it: 1 through 50. Sort by the random list to get them
listed in sequence from smallest/largest or largest/smallest. Then when you
want them back in the original random sequence, sort in ascending order by
the numbers in the helper column.
If the random numbers are generated by a formula within the cells using
RAND() or RANDBETWEEN(), all bets are off because the mere act of sorting
them causes a new list of random numbers to be generated ... they'll never be
sorted sequentially except by pure random chance.
:
A random number generator has delivered 50 sequences (rows) of numbers. Can
Excel list all the numbers sequentially (and just one time) from all the
rows?
Ask a Question
Want to reply to this thread or ask your own question?
You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.