Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 42
Default 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).


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default 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


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 42
Default 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?
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default 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


  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 42
Default 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




  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default 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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Using a cell's value to copy another cells info to another workshe badger2407 Excel Worksheet Functions 1 March 16th 10 09:21 PM
vbe - copy a cell's value by other workbook pls123 Excel Programming 2 December 12th 08 10:55 AM
matching numbers RodJ Excel Worksheet Functions 6 September 29th 08 12:26 PM
Formula to copy another cell's contents - Help! Richorton Excel Discussion (Misc queries) 6 August 7th 08 04:16 PM
How do you copy a cell's content verses it's formula? Tammy Excel Discussion (Misc queries) 1 March 2nd 05 06:30 PM


All times are GMT +1. The time now is 10:54 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"