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.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional