[bomb #21]

With the following values in A1:A10,

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

what code will return the count of values that feature more than once (i.e. 3 ; 2, 4 & 5)?

TIA,
Andy

[Glaswegian]

Andy

If it's just one value from the group I would go with

=SUMPRODUCT(--(A1:A10=2))

which will count the number of times '2' appears for example.

Anything more complicated you'll need someone else.

[Glaswegian]

Edit: This will work as well (formulae not my strong point!)

=COUNTIF(A1:A10,2)

[Zack Barresse]

If you used a secondary column, I'll assume column B, you could enter this in B1 and copy down ..

=COUNTIF($A$1:A1,A1)

Then in another cell you could get a count like so ..

=COUNTIF(B1:B10,">1")


You could of course do this with one formula, but it has some stipulations ..

=SUMPRODUCT(--(A1:A10=A2:A11))

This does require that you have one blank cell below your data. Note the ranges are the same size, just offset by one cell.

HTH

[bomb #21]

Actually I was wondering if it could be done with code.

[Zack Barresse]

Sure ..

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
            i = i + 1
            If Not IsNumeric(WorksheetFunction.Match(c, Arr(), 0)) Then
                ReDim Preserve Arr(1 To i)
                Arr(i) = c
            End If
        End If
    Next c
    CountNonUniques = i - WorksheetFunction.Count(Arr)
End Function

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

You can call from the worksheet like ..

=CountNonUniques(A1:A10)

HTH

[bomb #21]

I tried that & got 5. I must be saying it wrong.

I'm looking for an answer of 3 -- the count of values that are in the list more than once (three 2s, three 4s, two 5s).

TIA,
Andy

[OBP]

Bomb, I would approach this like the old BASIC programmer that I am.
I would loop through the cells in the range and place the values in a variable array.
I would then loop through the array counting the "same" values placing the count in a second array. I would then loop through the second array and count only values greater than 1.
If no one esle gives you an answer I will have a go at writing it for you.

[bomb #21]

Originally Posted by OBP

Bomb, I would approach this like the old BASIC programmer that I am.
I would loop through the cells in the range and place the values in a variable array.
I would then loop through the array counting the "same" values placing the count in a second array. I would then loop through the second array and count only values greater than 1.
If no one esle gives you an answer I will have a go at writing it for you.

Appreciate the response. Mainly I was curious as to if it could be done, clearly from your response it's "Yes", so in that sense "Solved". If you feel like actually doing it, I'd say only bother if it won't take too long.

Rgds,
Andy

[bomb #21]

The trick is to count a value that appears more than once only once while looping through the range, rather than counting it every time it occurs. As you kind of said, the non-unique values must be placed "somewhere" as you go, to enable double-checking (i.e. only put them "somewhere" if they haven't already been put there).

However, placing the non-unique values in an array is beyond me. I can only manage placing them in a spare column "one time only".

Rgds,
Andy

Sub Count_NonUniques()
For Each Cell In Range("A1:A10")
If WorksheetFunction.CountIf(Range("A1:A10"), Cell) > 1 Then
If WorksheetFunction.CountIf(Range("B1:B10"), Cell) = 0 Then
Cell.Copy Cell.Offset(0, 1)
End If
End If
Next Cell
x = WorksheetFunction.CountA(Range("B1:B10"))
Range("B:B").ClearContents
MsgBox x & " non-unique values exist."
End Sub

[cristobal03]

I've been working on something similar for Access 97; another user requested methods to derive the median and mode of a set of numbers.

The median was easy enough, but the mode--a lot like this application--is giving me all kinds of headaches. Logically speaking, though, if you only want to find the count of sets of numbers, it's a lot like a bubble sort. You iterate through your array, and compare each index to all the other indices. If two indices match, you increment a counter and move to the next index. When the control block ends, the counter represents the number of sets in your array.

Let me see if I can find the code I scrounged up yesterday; it was awfully close to that. I'll bump back.

chris.

[cristobal03]

[bump]

[edit 2]
The code in this post only works on a row-based range that is sorted and contains no empty cells. More code by myself and others posted on the next page.
[/edit 2]

Here's some stuff...I've sort of modified it to work with an Excel Range rather than an array. (The bulk of the bubble sort code has been adapted from a model posted at VBAExpress.com.)

Public Sub FindSets(ByVal strRng As String)
  Dim rng          As Range
  Dim c            As Range
  Dim vaArray()    As Variant
  Dim First        As Integer
  Dim Last         As Integer
  Dim i            As Integer
  Dim j            As Integer
  Dim intCount     As Integer


  Set rng = ActiveSheet.Range(strRng)
  ' zero-based?
  ReDim vaArray(rng.Rows.Count - 1)

  For Each c In rng
    ' not sure if this is appropriate assignment
    vaArray(i) = c.Value
    i = i + 1
  Next c

  Last = UBound(vaArray)

  For i = LBound(vaArray) To Last - 1
    For j = i + 1 To Last
      If vaArray(i) = vaArray(j) Then
        intCount = intCount + 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

  MsgBox "Number of sets of numbers: " & intCount
End Sub

I was testing in the Immediate window so I didn't have a Range object to pass; thus the string argument. This sub can be called like so:

FindSets "A1:A1052" ' my test; took less than a second
Call FindSets("A1:A1052")

HTH

chris.

[edit]
Added a second conditional to the Do While...Loop block to prevent subscript out of range error.
[/edit]

[bomb #21]

I should point out you're talking to a kludger. I don't understand:

This sub can be called like so:

Code:

FindSets "A1:A1052" ' my test; took less than a second
Call FindSets("A1:A1052")

[cristobal03]

Oh, I meant, the range "A1:A1052" was my test set, and running the code on that range took less than a second (bubble sort-type code is notoriously slow).

About calling the sub, I sort of borrowed Zack's idea about passing a range to the sub. It can be changed to set the range to ActiveSheet.Selection or whatever the object is for that.

The idea of passing a range is applicable only if you're using FindSets from within another subroutine (in which case it'd be better to pass a Range object anyway). I used a string argument so I could test easily in the VBA Editor's Immediate window--by typing something like findsets "a1:a100", or findsets "b:b", etc.

Also, see the edit to post #12...I corrected a line of code.

If you want more info about how to modify the code so it can be assigned to a button, post back.

HTH

chris.

[bomb #21]

Originally Posted by cristobal03

The idea of passing a range is applicable only if you're using FindSets from within another subroutine (in which case it'd be better to pass a Range object anyway). I used a string argument so I could test easily in the VBA Editor's Immediate window--by typing something like findsets "a1:a100", or findsets "b:b", etc.

Sorry, most of that is Greek to me. How do I actually run the code?