[cristobal03]

[bump]

[edit 2]
This is also rolling (i.e., incomplete) code. It will not work if the selection contains a set of empty cells at the beginning of the range and is not sorted. The final version of my code is posted further down the page.
[/edit 2]

Dang, a couple of caveats. The numbers have to be sorted. Also, the Integer data-type variables should probably be Long data types.

...

I've modified the code so that you can assign it to a button. It runs on a selection regardless of whether or not it's been sorted or the selection contains empty cells. It takes just a tad longer though; running on a column containing your example set (unsorted): 5, 2, 1, 3, 2, 4, 2, 5, 4, 4, took about a second.

Public Sub FindSets()

' Written for TSG user bomb_#21; finds the count
' of sets of numbers in a linear range.

  Dim rng          As Range
  Dim c            As Range
  Dim vaArray()    As Variant
  Dim tmp          As Variant
  Dim First        As Long
  Dim Last         As Long
  Dim i            As Long
  Dim j            As Long
  Dim lngCount     As Long
  Dim lngTrim      As Long

  Application.ScreenUpdating = False

  Set rng = Application.Selection
  ReDim vaArray(rng.Rows.Count - 1)

  For Each c In rng
    vaArray(i) = c.Value
    i = i + 1
  Next c

  First = LBound(vaArray)
  Last = UBound(vaArray)

  For i = First To Last - 1
    If Len(vaArray(i) & vbNullString) = 0 Then
    Else
      For j = i + 1 To Last
        If Len(vaArray(j) & vbNullString) = 0 Then
        Else
          If vaArray(i) > vaArray(j) Then
            tmp = vaArray(j)
            vaArray(j) = vaArray(i)
            vaArray(i) = tmp
          End If
        End If
      Next j
    End If
  Next i

  For i = First To Last
    If Len(vaArray(i) & vbNullString) = 0 Then
      lngTrim = lngTrim + 1
    End If
  Next i

  ReDim Preserve vaArray(UBound(vaArray) - lngTrim)

  Last = UBound(vaArray)

  For i = LBound(vaArray) To Last - 1
    For j = i + 1 To Last
      If vaArray(i) = vaArray(j) Then
        lngCount = lngCount + 1
        Do While (vaArray(i) = vaArray(j)) And (i < Last)
          i = i + 1
        Loop
        i = i - 1 ' to cover the Next i below
        j = Last
      End If
    Next j
  Next i

  Application.ScreenUpdating = True

  MsgBox "Number of sets of numbers: " & lngCount

End Sub

Hopefully that addresses all the mistakes I put in last time around.

chris.

[edit]
To run the code, copy it into a module, then in Excel, select a 1-dimensional range of values (e.g., a column or row), then run the macro called FindSets.

Keep in mind, the larger the list, the longer it takes. Testing this version on 1052 values now takes about 10 seconds rather than much less than a second. It's because I modified this version to incorporate a sorting procedure.

(I just fixed that, if your interested, plus commented the code.)
[/edit]

[bomb #21]

Originally Posted by cristobal03

I've modified the code so that you can assign it to a button. It runs on a selection regardless of whether or not it's been sorted or the selection contains empty cells.

Mine runs without selection & regardless of order. But the main thing is that yours works "virtually" -- good job.

[cristobal03]

Glad I could help.

Check the edit in my last post, I've edited the code to add a couple things.

(I hate rolling code by the way, I'm really sorry I keep doing that in these threads )

chris.

[Dreambringer]

Sorry to jump in, but I was wondering if there was a way for the out put to put the unique sets as well as the totals i.e.

1= 3
2=2
3=1

Or is that too much trouble?

[bomb #21]

Originally Posted by Dreambringer

Sorry to jump in, but I was wondering if there was a way for the out put to put the unique sets as well as the totals i.e.

1= 3
2=2
3=1

Or is that too much trouble?

I don't get what you mean. However, you should be able to see that the code chris has now done could be used to "predict" how many blank rows would be inserted in respect of your "not sure if it can be done" thread. Good timing!

[Dreambringer]

Well lets say for example using Bombs Numbers

1, 2, 2, 2, 3, 4, 4, 4, 5, 5

Is there a way that code can be manipulated to show how many 1s, 2s, 3s ect

So the output would be 1=1 , 2=3, 3=1,4=3,5=2.

[Zack Barresse]

Sorry I didn't see this earlier. You could just drop the i count and count the array, as it is only those which appear multiple times, and one instance of it, that's all. Is that what you're looking for?

Option Explicit

Public Function CountNonUniques(refRng As Range) As Long
    Dim i As Long, n As Long, c As Range
    Dim Arr(), tmp, isIn, wf As WorksheetFunction
    For Each c In refRng
        On Error Resume Next
        tmp = WorksheetFunction.CountIf(refRng, c)
        If Not IsEmpty(tmp) And tmp > 1 Then
            If Not IsNumeric(WorksheetFunction.Match(c, Arr(), 0)) Then
                i = i + 1
                ReDim Preserve Arr(1 To i)
                Arr(i) = c
            End If
        End If
    Next c
    CountNonUniques = WorksheetFunction.Count(Arr)
End Function

Sub callTest()
     MsgBox CountNonUniques(Range("A1:A10"))
End Sub

Call in the same fashion. Big difference between mine and Chris'? Mine is a function whereas Chris' is a sub routine. Not much difference and I have not run any efficiency tests on it. But there's a couple solutions for you.

[cristobal03]

I'm sure Zack's is better because it uses native Excel objects. I'm trying to get mine modular enough to work on just about any 1-dimentional selection regardless of whether or not it's been sorted and how many empty cells it contains/where the empty cells fall, without using any Excel objects except Range and Selection. It's not very easy, and doesn't adhere at all to the KISS principle. So I'd say go with Zack's. I basically took this on because I thought it might shed some light on my trouble with finding the mode/modes of a set, and I think it has, so.



Just saying, mine isn't nearly as modular as it needs to be. So far the only real problem I've found is that if the range is sorted but includes empty cells at the beginning, my subroutine computes an incorrect result.

chris.

[cristobal03]

[bump]

Zack, what is the purpose of these two variables?

isIn, wf As WorksheetFunction

I'm guessing the idea of isIn is a boolean or integer data type to test if a number was in a set of numbers? Also, for an object WorksheetFunction, would you have to Set the object to a specific function? Or could you use it for shorthand, like, wf.Count(Arr)?

Just curious.

chris.

[Zack Barresse]

You can use it shorthand (wf) although not in this case. I was using it wrong and forgot to take my variables out. Sorry. They're not used and can be discarded.

[cristobal03]

My last'n in this thread. Still not as good in Excel as Zack's, but this can be easily adapted to any application that supports VBA (by taking out the ranges and passing a list of values as an argument, for example).

I overcame my earlier hangups by excluding empty cells from the array entirely. The original was poor design on my part; I wasn't using arrays as they were meant to be used--dynamic collections. Anyway. You caught me, I'm lame.

Oh, I also changed the sub so that it works on columns as well. Anyway.

Public Sub FindSets()

' Written for TSG user bomb_#21; finds the count
' of sets of numbers in a linear range.

  ' The user-defined variables:
  ' rng              the selected range (row or col,
  '                  or 1-dimentional selection)
  ' c                a Range object representing one cell
  ' vaArray()        stores the values of each cell in
  '                  the range; facilitates sorting and
  '                  index-to-index comparison
  ' tmp              used if the range has to be sorted;
  '                  a temporary container to store the
  '                  value of an index so it can be swapped
  '                  with another index
  ' First            the lower bound of vaArray
  ' Last             the upper bound of vaArray
  ' i                main index increment counter
  ' j                secondary index increment counter
  ' lngCount         increments once per set of non-unique
  '                  values; represents the "return value"
  '                  of the subroutine
  ' fUnSorted        used to test the sorted condition of
  '                  the array; dimensioned by default "false"
  Dim rng            As Range
  Dim c              As Range
  Dim vaArray()      As Variant
  Dim tmp            As Variant
  Dim First          As Long
  Dim Last           As Long
  Dim i              As Long
  Dim j              As Long
  Dim lngCount       As Long
  Dim fUnSorted      As Boolean

  ' Save some processor.
  Application.ScreenUpdating = False

  ' Originally FindSets took a String argument representing a
  ' range.  Also would work with a ByRef Range object.  Using
  ' selection allows user to assign macro to a button on the
  ' toolbar more easily.
  Set rng = Application.Selection

  ' Dimension the array based on the type of selection (row-wise
  ' or column-wise).  Otherwise, prompt user and exit sub.
  If rng.Rows.Count > 1 Then
    ReDim vaArray(rng.Rows.Count - 1)
  ElseIf rng.Columns.Count > 1 Then
    ReDim vaArray(rng.Columns.Count - 1)
  Else
    MsgBox "The specified action cannot be performed " & _
           "on a single cell.  Select a 1-dimensional " & _
           "range (e.g., a row or column) and try again.", _
           vbOKOnly + vbCritical, _
           "Error!"
    Exit Sub
  End If

  ' For each cell in the range, take that cell's value and push it
  ' into the array (excluding empty cells).
  For Each c In rng
    If Len(c.Value & vbNullString) <> 0 Then
      vaArray(i) = c.Value
      i = i + 1
    End If
  Next c

  ' Since the array was dimensioned to include the maximum possible
  ' indices, and some indices may be empty, trim the empty indices
  ' (i - 1 because i gets incremented at the end of the previous
  ' control block; i++ rather than ++i).
  ReDim Preserve vaArray(i - 1)

  ' Define the array's boundaries.
  First = LBound(vaArray)
  Last = UBound(vaArray)

  ' This control block checks to see if the range has been sorted.
  ' Logically, since the values were pushed into the array in order,
  ' if the value of an index between two other indices is greater or
  ' less than both, the array is unsorted.  There might be a way to
  ' do this more easily, if there's an IsSorted property somewhere in
  ' Excel's object model.  Goes from 1 to Last - 1 because it tests
  ' indices below and above the current index.
  For i = 1 To Last - 1
    If (vaArray(i + 1) < vaArray(i)) And (vaArray(i - 1) < vaArray(i)) Or _
       (vaArray(i + 1) > vaArray(i)) And (vaArray(i - 1) > vaArray(i)) Then
       fUnSorted = True
       Exit For
    End If
  Next i

  ' If vaArray is unsorted, we need to sort it.  This is a bubble sort.
  If fUnSorted = True Then
    For i = First To Last - 1
      For j = i + 1 To Last
        If vaArray(i) > vaArray(j) Then
          tmp = vaArray(j)
          vaArray(j) = vaArray(i)
          vaArray(i) = tmp
        End If
      Next j
    Next i
  End If

  ' Now, count the number of sets.  If an index is equal to another index,
  ' there's a set.  Increment the counter and iterate through the set to
  ' position the block at the first unique value after the set.
  For i = LBound(vaArray) To Last - 1
    For j = i + 1 To Last
      If vaArray(i) = vaArray(j) Then
        lngCount = lngCount + 1
        Do While (vaArray(i) = vaArray(j)) And (i < Last)
          i = i + 1
        Loop
        i = i - 1 ' to cover the Next i below
        j = Last
      End If
    Next j
  Next i

  ' See the results.
  Application.ScreenUpdating = True

  MsgBox "Number of sets of numbers: " & lngCount

End Sub

So, yeah. The end.

chris.

[edit]
Left out a comment or two.
[/edit]

[Dreambringer]

nevermind, I dont know why I was trying to make things difficult, when you can just use subtotals.. sorry to be such a tard