Copy Matching Numbers To New Cell's
 

Here is an example of two number sets I'm using in cells A1:J1 and
A2:J2

4 6 9 15 16 20 21 27 28 29

5 7 9 13 16 21 27 27 31
37

Sometime's my number sets won't have any matching numbers, sometimes
all 10 will match. I would like to copy any of the numbers in set two
that match any of the numbers in set one into cells L2:U2 without
duplicates (27 in this example).

For this example I would end up with 9 16 21 27 in cells L2:O2
P2:U2 would be left blank (no zero in cell).

Copy Matching Numbers To New Cell's
 

JAgger1 has brought this to us :
Here is an example of two number sets I'm using in cells A1:J1 and
A2:J2

4 6 9 15 16 20 21 27 28 29

5 7 9 13 16 21 27 27 31
37

Sometime's my number sets won't have any matching numbers, sometimes
all 10 will match. I would like to copy any of the numbers in set two
that match any of the numbers in set one into cells L2:U2 without
duplicates (27 in this example).

For this example I would end up with 9 16 21 27 in cells L2:O2
P2:U2 would be left blank (no zero in cell).

Try...

Sub CheckForDupes()
Dim v1, v2 'as variant
Dim s1 As String
Dim i&, j&, lMatches& 'as long
v1 = Range("$A$1:$J$1"): v2 = Range("$A$2:$J$2")
For i = 1 To Range("$A$2:$J$2").Cells.Count
For j = 1 To Range("$A$1:$J$1").Cells.Count
If v2(1, i) = v1(1, j) _
And Not InStr(1, s1, v2(1, i)) 0 _
Then s1 = s1 & "," & v2(1, i): lMatches = lMatches + 1
Next 'j
Next 'i
Range("$L$2").Resize(1, lMatches) = Split(Mid$(s1, 2), ",")
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Copy Matching Numbers To New Cell's
 

On Jan 23, 3:45*pm, GS wrote:
JAgger1 has brought this to us :

Here is an example of two number sets I'm using in cells A1:J1 and
A2:J2

4 * * 6 * * *9 * * 15 * * 16 * * *20 * * *21 * * *27 * * *28 * * *29

5 * * 7 * * *9 * * 13 * * 16 * * *21 * * *27 * * *27 * * *31
37

Sometime's my number sets won't have any matching numbers, sometimes
all 10 will match. I would like to copy any of the numbers in set two
that match any of the numbers in set one into cells L2:U2 without
duplicates (27 in this example).

For this example I would end up with 9 16 21 27 in cells L2:O2
P2:U2 would be left blank (no zero in cell).

Try...

Sub CheckForDupes()
* Dim v1, v2 'as variant
* Dim s1 As String
* Dim i&, j&, lMatches& 'as long
* v1 = Range("$A$1:$J$1"): v2 = Range("$A$2:$J$2")
* For i = 1 To Range("$A$2:$J$2").Cells.Count
* * For j = 1 To Range("$A$1:$J$1").Cells.Count
* * * If v2(1, i) = v1(1, j) _
* * * * And Not InStr(1, s1, v2(1, i)) 0 _
* * * * Then s1 = s1 & "," & v2(1, i): lMatches = lMatches + 1
* * Next 'j
* Next 'i
* Range("$L$2").Resize(1, lMatches) = Split(Mid$(s1, 2), ",")
End Sub

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Thanks Garry

That works perfect

How would i modify that to work with 100 sets of numbers? Only
matching two sets at a time ie: A1:J1 - A2:J2, A2-J2 - A3-J3?

Copy Matching Numbers To New Cell's
 

Try...

Sub CheckForDupes2()
Dim v1, v2, vCalcMode 'as variant
Dim s1 As String, bEventsEnabled As Boolean
Dim i&, j&, lMatches&, r& 'as long
With Application
vCalcMode = .Calculation: bEventsEnabled = .EnableEvents
.Calculation = xlCalculationManual: .EnableEvents = False
.ScreenUpdating = False
End With 'Application
For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row - 1
v1 = Range("$A$" & r & ":$J$" & r)
v2 = Range("$A$" & r & ":$J$" & r).Offset(1)
s1 = "": lMatches = 0 '//initialize variables for each pass
For i = 1 To Range("$A:$J").Columns.Count
For j = 1 To Range("$A:$J").Columns.Count
If v2(1, i) = v1(1, j) _
And Not InStr(1, s1, v2(1, i)) 0 Then _
s1 = s1 & "," & v2(1, i): lMatches = lMatches + 1: Exit For
Next 'j
Next 'i
With Range("$L$" & r).Offset(1).Resize(1, lMatches)
.Value = Split(Mid$(s1, 2), ","): .NumberFormat = "General"
End With
Next 'r
With Application
.Calculation = vCalcMode: .EnableEvents = bEventsEnabled
.ScreenUpdating = True
End With 'Application
End Sub 'CheckForDupes2

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Copy Matching Numbers To New Cell's
 

Excellent! That works perfect. Thanks again Garry


On Jan 23, 8:41*pm, GS wrote:
Try...

Sub CheckForDupes2()
* Dim v1, v2, vCalcMode 'as variant
* Dim s1 As String, bEventsEnabled As Boolean
* Dim i&, j&, lMatches&, r& 'as long
* With Application
* vCalcMode = .Calculation: bEventsEnabled = .EnableEvents
* * .Calculation = xlCalculationManual: .EnableEvents = False
* * .ScreenUpdating = False
* End With 'Application
* For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row - 1
* * v1 = Range("$A$" & r & ":$J$" & r)
* * v2 = Range("$A$" & r & ":$J$" & r).Offset(1)
* * s1 = "": lMatches = 0 '//initialize variables for each pass
* * For i = 1 To Range("$A:$J").Columns.Count
* * * For j = 1 To Range("$A:$J").Columns.Count
* * * * If v2(1, i) = v1(1, j) _
* * * * * And Not InStr(1, s1, v2(1, i)) 0 Then _
* * * * * s1 = s1 & "," & v2(1, i): lMatches = lMatches + 1: Exit For
* * * Next 'j
* * Next 'i
* * With Range("$L$" & r).Offset(1).Resize(1, lMatches)
* * * .Value = Split(Mid$(s1, 2), ","): .NumberFormat = "General"
* * End With
* Next 'r
* With Application
* * .Calculation = vCalcMode: .EnableEvents = bEventsEnabled
* * .ScreenUpdating = True
* End With 'Application
End Sub 'CheckForDupes2

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Copy Matching Numbers To New Cell's
 

You're welcome! I appreciate the feedback...

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc