Copy Matching Numbers To New Cell's

[JAgger1]

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).

 

[GS]

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

 

[JAgger1]

JAgger1 has brought this to us :






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?

 

[GS]

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

 

[JAgger1]

Excellent! That works perfect. Thanks again Garry

 

[GS]

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