Search and Display

[Maxi]

I have the follwing data in A1:T17

3,4,7,9,10,11,21,32,33,35,37,41,47,57,60,64,69,72,74,75
4,6,9,10,12,13,15,21,22,31,35,47,49,52,56,63,64,72,74,75
4,6,9,10,15,21,31,33,34,41,42,45,46,47,57,60,68,72,74,78
3,4,6,10,11,13,18,21,30,32,33,35,46,53,60,67,69,74,77,78
6,9,13,16,21,22,31,46,48,49,52,61,63,64,69,70,71,75,78,79
3,4,7,10,14,17,18,21,28,31,33,36,37,43,47,57,65,69,75,80
4,7,13,15,17,25,29,32,37,42,45,47,50,57,60,64,68,71,72,74
3,7,10,11,16,18,28,34,35,43,47,51,52,55,56,57,60,64,71,72
8,9,10,12,16,21,22,28,38,47,49,51,52,53,54,55,64,66,71,72
4,5,6,9,12,15,19,20,30,34,35,38,45,47,54,56,63,65,72,78
5,6,9,12,15,21,26,31,32,43,44,47,64,66,67,68,69,74,75,80
4,7,9,10,11,20,28,29,30,32,34,35,40,41,49,52,66,69,70,74
3,4,8,10,14,20,21,23,28,29,32,37,44,47,48,49,56,64,69,72
1,6,9,10,11,13,21,25,29,33,36,43,48,49,51,52,63,65,72,74
1,3,7,11,14,18,27,33,35,37,39,41,45,47,48,53,64,65,75,77
3,4,5,6,11,13,15,18,28,29,35,56,61,63,64,69,71,74,75,80
3,13,15,21,24,27,28,35,47,48,49,54,56,57,63,72,75,76,77,79


I want to compare the first set of 20 numbers (A1:T1) with the second
set (A2:T2) and check how many numbers match. ** If the matched numbers
are >=10 ** then list them to the right of cell W1. In this example, 10
numbers matched are 4,9,10,21,35,47,64,72,74,75. List them in W1:AF1.

Now compare (A1:T1) with (A3:T3). In this example, 11 numbers matched
4,9,10,21,33,41,47,57,6,72,74 list them in W2:AG2.

Now compare (A1:T1) with (A4:T4). 10 numbers matched
3,4,10,11,21,32,33,35,60,69 list them in W3:AF3.

Compare (A1:T1) with (A5:T5). Here only 5 numbers matched 9,21,64,69,75
(Which is ** less than 10 ** - does not match the criteria) DO NOT LIST
this.

Compare (A1:T1) with (A6:T6). 11 numbers matched,
3,4,7,10,21,33,37,47,57,69,75 list them in cell W4:AG4.

Go on comparing (A1:T1) with all other sets of 20 numbers till
(A17:T17).

Once finished, start comparing (A2:T2) with (A3:T3), then (A2:T2) with
(A4:T4) ..... (A2:T2) with (A17:T17).

Once finished, start comparing (A3:T3) with (A4:T4), then (A3:T3) with
(A5:T5) ..... (A3:T3) with (A17:T17).

Go on doing this till (A16:T16) with (A17:T17).

Can anybody help?

Thanx
Maxi

 

[Nigel]

Code for the match - NOTE: duplicates will be double counted, but I did not
detect any duplicates in your sample so it should be OK as it is. If there
are more than 233 duplicate pairs in the any two row combination the
worksheet overflows! One way around this would be to put results into an
array and dedupe the list before writing back to the worksheet.

Sub Compare()
Dim r As Integer, rr As Integer, c As Integer, cc As Integer, opc As
Integer, opr As Long

opr = 1
For r = 1 To 16
For rr = r + 1 To 17
opc = 23
For c = 1 To 20
For cc = 1 To 20
If Cells(r, c) = Cells(rr, cc) Then
Cells(opr, opc) = Cells(r, c)
opc = opc + 1
End If
Next cc
Next c
opr = opr + 1
Next rr
Next r

End Sub

 

[Maxi]

Thank you Nigel, This was end of step1. However, need little bit of
modification.

1. This is a question: I am referring to the line "For r = 1 To 16" Why
1 to 16? There are 17 rows !

2. It also displays matching numbers which are less than 10 eg.W4:AA4,
W8:AB8. I don't want to list them. Can you put a condition near the
line Cells(opr, opc) = Cells(r, c) such after listing the series, if it
is less than 10 then remove it and do not increment the counter so that
the next series (if >=10) will be listed there.

3. It is okay if dupilicates are double counted. In fact I DO NOT want
to eliminated duplicates. I want them.

4. The 17 row I listed is just a sample, I have around 1000+ rows and
looking at your solution and response, I feel that the worksheet will
definitely overflow. Can you modify this so that the results go to an
array? At this moment do not dedupe it, let the results be in an array.
I will let you know what to do with the array later.

 

[Maxi]

Answering my second question in my previous post, I did some
modification myself but I am not sure it is correct and whether it is
efficient enough as far as processing is concerned.

Here is what I did:

I have changed this part of the code

Next c
opr = opr + 1
Next rr

to

Next c
If WorksheetFunction.Count(Range("W" & opr & ":AO" & opr)) < 10
Then
Range("W" & opr & ":AO" & opr).ClearContents
Else
opr = opr + 1
End If
Next rr

and it works now. Now it displays only series which are >=10

Please let me know if it is correct.

Next step:
=======
The modified vba will give only 19 results listed below:
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,72,
4,7,9,10,11,32,35,41,69,74,
3,4,10,21,32,37,47,64,69,72,
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,
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,

If you notice, out of these 19 records, 2nd, 3rd, 4th and 11th record
has 11 numbers and rest 15 records have 10 numbers. I want to create
all possible combinations of 10 numbers of the 2nd, 3rd, 4th and 11th
record and list it with the other 15 records.

After creating combinations, total records will jump from 19 to 59

=combin(11,10) * 4 = 44 (11 = total numbers present, *4 = 4 such
records)
44+15 = 59 (44 above answer, 15 = rest of the records with only 10
numbers)

I want to list these total 59 records in the range W1:AF59. If
possible, instead of listing them in the worksheet, add it to an array
and keep it as it is. I will let you know what is to be done later.
Again, if there are duplicates, let it be. I want them.

Let me know if it is getting confusing and whether you need any further
clarification.

Thanks
Maxi

 

[Maxi]

The code below runs fine for my question given in the first post but If
I increase my rows from 17 to 1200 it takes 3 1/2 hours to complete.
Can it be reduced? I am okay if the results go into an array instead of
listing them on the worksheet.

opr = 1
For r = 1 To 16
For rr = r + 1 To 17
opc = 23
For c = 1 To 20
For cc = 1 To 20
If Cells(r, c) = Cells(rr, cc) Then
Cells(opr, opc) = Cells(r, c)
opc = opc + 1
End If
Next cc
Next c
If WorksheetFunction.Count(Range("W" & opr & ":AO" & opr)) < 10
Then
Range("W" & opr & ":AO" & opr).ClearContents
Else
opr = opr + 1
End If

Next rr
Next r

End Sub

 

[Maxi]

Forgot to type the first lines in the previous post

Dim r As Integer, rr As Integer, c As Integer, cc As Integer, opc As
Integer, opr As Long