Re: Tom Ogilvy - Need a little change

Sorry about the confusion. I mean 1 X 10 being repeated (the entire
row).

eg.
1,2,3,4,5,6,7,8,9,10
1,2,3,4,5,6,7,8,9,11
1,2,3,4,5,6,7,8,9,10
1,2,3,4,5,6,7,8,9,12
1,2,3,4,5,6,7,8,9,10

1,2,3,4,5,6,7,8,9,10 : repeated thrice

Tom Ogilvy wrote:
Define "in the array"

The array has 4411 x 10 elements.

Are you talking about entire rows being repeated?

Are you talking about elements repeating in each single row?

Need a better definition of what you are looking for.

--
Regards,
Tom Ogilvy


"Maxi" <maheshchindarkar@xxxxxxxxx> wrote in message
news:1156859274.356293.225030@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
I need little bit of calculation/validation within the array. Check for
duplicate entries within the array and find out which element of the
array is repeated the highest number of times. I want to keep only
those elements which are repeated the highest number of times and
(highest -1) in the array and remove all other elements.

For example:
If there are elements which is repeated 4 times, then keep those
elements and also keep those which are repeated 3 times (highest -1)
and remove all other elements from the array.

If there are elements which is repeated 7 times, then keep those
elements and also keep those which are repeated 6 times (highest -1)
and remove all other elements from the array.

If there are elements which is repeated 2 times, then keep all elements
in the array and do not remove anything.

In my example, you might not get any duplicates, you might have to
change some data in the range W1:AK19 so that few duplicate entries
goes into the array.

Thanks
Maxi

Tom Ogilvy wrote:
Option Explicit
Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
Dim rng1 As Range, ans As Variant
Dim irw As Long, rw As Range
Dim v1() As Long, i As Long
Dim v2() As Long, cnt As Long
Dim tot As Long, sh As Work***
Dim s As String
Set rng1 = Range("W1:AK19")
ReDim v1(1 To rng1.Rows.Count, 2)
i = 0
For Each rw In rng1.Rows
cnt = Application.Count(rw)
i = i + 1
v1(i, 1) = cnt
v1(i, 2) = Application.Combin(cnt, 10)
tot = tot + v1(i, 2)
Next
ReDim v2(1 To tot, 1 To 10)
i = 0
irw = 1
For Each rw In rng1.Rows
i = i + 1
cnt = v1(i, 1)
Set rng = rw.Cells.Resize(1, cnt)
v = Application.Transpose(Application _
.Transpose(rng))
n = cnt 'UBound(v, 1)
m = 10
Comb2 n, m, 1, "'", v, v2, irw
Next
Do
s = ""
ans = Application.InputBox( _
"Enter a number between " & _
"1 and " & tot & ":" & vbNewLine & _
"(Hit cancel to quit)", _
"Show Combinations", tot, _
Type:=1)
If ans = False Then Exit Do
If ans >= 1 And ans <= tot Then
For i = 1 To m
s = s & v2(ans, i) & ","
Next
s = Left(s, Len(s) - 1)
MsgBox "For row " & ans & " combinations" & _
" are: " & vbNewLine & vbNewLine & s
Else
MsgBox "Row " & ans & "doesn't exits"
End If
Loop
'
' Uncomment the next 3 lines if you want a new *** with
' all the combinations listed on it (for validation purposes)
'
' Worksheets.Add After:=Worksheets(Worksheets.Count)
' Set sh = Active***
' sh.Range("A1").Resize(tot, 10).Value = v2
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant, _
v2() As Long, irw As Long)
Dim v1 As Variant, i As Long
If m > n - k + 1 Then Exit Sub
If m = 0 Then
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
v2(irw, i + 1) = v(v1(i))
Next
irw = irw + 1
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v, v2, irw
Comb2 n, m, k + 1, s, v, v2, irw
End Sub

--
Regards,
Tom Ogilvy


"Maxi" wrote:

Hi Tom,

You had given me the below code. I need a little change. Please help me
out one more time.

Now I don't need an input box for m [ m = InputBox("Taken how many at a
time?", "Combinations") ]. It will be 10 (fixed).

There is a difference in the range as well. I have the following
numbers in the range W1:AK19 (please do not change the range let it be
in W1:AK19)

4,9,10,21,35,47,64,72,74,75
4,9,10,21,33,41,47,57,60,72,74
3,4,10,11,21,32,33,35,60,69,74
3,4,7,10,21,33,37,47,57,69,75
4,7,32,37,47,57,60,64,72,74
3,7,10,11,35,47,57,60,64,66,67,72,73,79,80
4,7,9,10,11,32,35,41,69,74
3,4,10,21,32,37,47,64,69,72,75,77
3,7,11,33,35,37,41,47,64,75
4,6,9,10,15,21,31,47,72,74
6,9,13,21,22,31,49,52,63,64,75
9,10,12,21,22,47,49,52,64,72
4,6,9,12,15,35,47,56,63,72
6,9,12,15,21,31,47,64,74,75
6,9,10,13,21,49,52,63,72,74,75,79,80
4,6,13,15,35,56,63,64,74,75
13,15,21,35,47,49,56,63,72,75
4,15,42,45,47,57,60,68,72,74
10,16,28,47,51,52,55,64,71,72,74,75,76,77

I want to create combinations of the first series W1:AF1 =combin(10,1)
then below that I want to create combinations for the second series
W1:AG1 =combin(11,10) and go on listing combinations one below the
other for all the 19 series.

Total combinations should be 4411

I do not want to list these total 4411 combinations on a work***, I
want to send it to an array either and towards the end of the code,
just before 'End Sub" I need an input box asking me which combination
to display. If I type 34, it should display 34th element of the array
in the range AM1:AV1

Your code:

Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
numcomb = 0
Set rng = Range("A1:T1")
'Set rng = rng.Resize(1, 5)
v = Application.Transpose(Application _
.Transpose(rng))
n = UBound(v, 1)
m = InputBox("Taken how many at a time?", "Combinations")
If Application.Combin(n, m) > 64530 Then
MsgBox "Too many to write out, quitting"
Exit Sub
End If
Range("A3").Select
Comb2 n, m, 1, "'", v
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m > n - k + 1 Then Exit Sub
If m = 0 Then
'Debug.Print "->" & s & "<-"
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
ActiveCell.Offset(0, i) = v(v1(i))
Next
ActiveCell.Offset(1, 0).Select
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v
Comb2 n, m, k + 1, s, v
End Sub

Thanx
Maxi




.