find duplicates and concatenate

[rpick60]

I am trying to find all duplicates in a range R8:R1000 and then grab
the value in Column C of the the duplicate rows and concatenante them
all to the cell in S of that row

example
As you can see find each cell in range R8:R1000 and the grab value in
column C
and put all duplicates in column s
for each P1 in the range the results are 2,4,5 for each duplicate.


c d ....... r s (results)
2 P1 2,4,5
3 P2 3
12 P5 12,13
13 P5 12,13
4 P1 2,4,5
5 P1 2,4,5
10 P22 10


Any help would be great!


and "Go Wings"

 

[Joel]

Sub Cat_Dups()

For Each Cell1 In Range("R8:R1000")
CatStr = ""
For Each Cell2 In Range("R8:R1000")
If Cell1.Value = Cell2.Value Then
If CatStr = "" Then
CatStr = Range("C" & Cell2.Row).Value
Else
CatStr = CatStr & ", " & Range("C" & Cell2.Row).Value
End If
End If
Next Cell2
Cell1.Offset(0, 1).Value = CatStr
Next Cell1
End Sub

 

[rpick60]

Sub Cat_Dups()

For Each Cell1 In Range("R8:R1000")
   CatStr = ""
   For Each Cell2 In Range("R8:R1000")
      If Cell1.Value = Cell2.Value Then
         If CatStr = "" Then
            CatStr = Range("C" & Cell2.Row).Value
         Else
            CatStr = CatStr & ", " & Range("C" & Cell2.Row).Value
         End If
      End If
   Next Cell2
   Cell1.Offset(0, 1).Value = CatStr
Next Cell1
End Sub









- Show quoted text -

Joel
Thanks for th help. But i only get 1 value in column S. I am looking
for all of the duplicates to be listed.
Am i missing something
thanks again

 

[rpick60]

Joel
Thanks for th help. But i only get 1 value in column S. I am looking
for all of the duplicates to be listed.
Am i missing something
thanks again- Hide quoted text -

- Show quoted text -

Joel
Sorry my mistake I figured it out.
It works great, thanks for the quick response

 

[Joel]

It should work. Try an experiment by emptying some cell in column R. the
code presently considers two empty cell a duplicate. If this works, then the
cell do not equal each other in column R.

Also make sure you are looking at column S.