On Sunday, May 25, 2014 12:46:18 PM UTC-7, Claus Busch wrote:
Hi Howard,



Am Sun, 25 May 2014 11:53:48 -0700 (PDT) schrieb L. Howard:



Well, that is a pretty good conversion, actually a re-write. Sure seem to me to do the trick. That Function.CountIf part that sorts it all out is always a mystery to me. I can get part way through it and then bog down.



here is a suggestion that writes the duplicate values in one line:



Sub FindDupes()

Dim LRow As Long, i As Long

Dim myDic As Object

Dim arrIn As Variant, arrCheck As Variant

Dim c As Range

Dim FirstAddress As String, myStr As String



With Sheets("Sheet1")

LRow = .Cells(Rows.Count, "T").End(xlUp).Row

arrIn = .Range("T1:T" & LRow)



Set myDic = CreateObject("Scripting.Dictionary")

For i = LBound(arrIn) To UBound(arrIn)

myDic(arrIn(i, 1)) = arrIn(i, 1)

Next

arrCheck = myDic.items



For i = LBound(arrCheck) To UBound(arrCheck)

If WorksheetFunction.CountIf(.Range("T1:T" & LRow), _

arrCheck(i)) 1 Then

Set c = .Range("T1:T" & LRow).Find(arrCheck(i),

after:=.Cells(LRow, "T"), _

LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then

FirstAddress = c.Address

myStr = myStr & arrCheck(i)

Do

myStr = myStr & vbTab & c.Address(0, 0) & ", "

Set c = .Range("T1:T" & LRow).FindNext(c)

Loop While Not c Is Nothing And c.Address <

FirstAddress

End If

myStr = Left(myStr, Len(myStr) - 2) & Chr(10)

End If

Next

End With

MsgBox myStr

End Sub





Regards

Claus B.

--

Careful Claus, people will soon ask you to turn straw into gold with goodies like this.

I remain amazed, really easy to read the out put with the dupe and the cells in a row that hold it.

Thanks a ton.

Regards,
Howard