Find dupes, list in MsgBox with cell.address convert ws wide code toone sheet

[L. Howard]

Trying to convert this code to sheet 1 only, one column only (col T) and list all dupes in a msgbox with cell.address.

The search item could be for a number or text.

Thanks.
Howard


Sub FindSheetsWithID()
'/ code by Garry
' Looks for an ID on all sheets except "Sheet1",
' and notifies the result of the search.
Dim ws As Worksheet, Rng As Range
Dim sID$, sIdShts$, sMsg$
Dim bFoundID As Boolean

sID = InputBox("Enter a Client ID number")
If Trim(sID) = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Sheet1" Then
Set Rng = ws.UsedRange.Find(What:=sID, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns)
If Not Rng Is Nothing Then
bFoundID = True

sIdShts = sIdShts & ",'" & ws.Name & "'!" & Rng.Address

End If
End If
Next ws
If bFoundID Then
sMsg = "The ID (" & sID & ") was found on the following sheets:"
sMsg = sMsg & vbLf & vbLf
sMsg = sMsg & Join(Split(Mid(sIdShts, 2), ","), vbLf)


Else
sMsg = "ID not found"
End If
MsgBox sMsg
End Sub

 

[Claus Busch]

Hi Howard,

Am Sun, 25 May 2014 08:40:59 -0700 (PDT) schrieb L. Howard:

Trying to convert this code to sheet 1 only, one column only (col T) and list all dupes in a msgbox with cell.address.

The search item could be for a number or text.

the first match will be ignored. All other matches will be listed:

Sub FindDupes()
Dim LRow As Long, i As Long
Dim myStr As String

With Sheets("Sheet1")
LRow = Cells(Rows.Count, "T").End(xlUp).Row
For i = 1 To LRow
If WorksheetFunction.CountIf(.Range(.Cells(1, "T"), _
.Cells(i, "T")), .Cells(i, "T")) > 1 Then
myStr = myStr & .Cells(i, "T").Value & vbTab & _
.Cells(i, "T").Address(0, 0) & Chr(10)
End If
Next
End With
MsgBox myStr
End Sub


Regards
Claus B.

 

[L. Howard]

Hi Howard,



Am Sun, 25 May 2014 08:40:59 -0700 (PDT) schrieb L. Howard:






the first match will be ignored. All other matches will be listed:



Sub FindDupes()

Dim LRow As Long, i As Long

Dim myStr As String



With Sheets("Sheet1")

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

For i = 1 To LRow

If WorksheetFunction.CountIf(.Range(.Cells(1, "T"), _

.Cells(i, "T")), .Cells(i, "T")) > 1 Then

myStr = myStr & .Cells(i, "T").Value & vbTab & _

.Cells(i, "T").Address(0, 0) & Chr(10)

End If

Next

End With

MsgBox myStr

End Sub





Regards

Claus B.

--

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.

Thanks.
Howard

 

[L. Howard]

Hi Howard,



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






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

 

[GS]

I'm thinking that once the dictionary is loaded, you don't need to use
CountIf/Find since relooping the array for items already in the
dictionary can returns the item plus Cells(i, "T").Address. This would
be orders of magnitude faster if the list is lengthy with lots of
dupes!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Claus Busch]

Hi Garry,

Am Sun, 25 May 2014 18:50:40 -0400 schrieb GS:

I'm thinking that once the dictionary is loaded, you don't need to use
CountIf/Find since relooping the array for items already in the
dictionary can returns the item plus Cells(i, "T").Address. This would
be orders of magnitude faster if the list is lengthy with lots of
dupes!

can you please explain a little further. Howard wants to list the dupes
with the addresses. The dictionary gives me all items but I don't know
if these items occur only once or more in column T.


Regards
Claus B.

 

[GS]

Hi Garry,

Am Sun, 25 May 2014 18:50:40 -0400 schrieb GS:


can you please explain a little further. Howard wants to list the
dupes with the addresses. The dictionary gives me all items but I
don't know if these items occur only once or more in column T.


Regards
Claus B.

Ok, I'm thinking that the dictionary contains 'unique' items only and
so rather than searching the worksheet via CountIf/Find you could just
query the dictionary (by relooping the array) to see if the item
exists. If so then it's value is already found and its address is the
row of colT that aligns with the array index.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion