Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find dupes, list in MsgBox with cell.address convert ws wide code toone sheet
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find dupes, list in MsgBox with cell.address convert ws wide code to one sheet
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. -- Vista Ultimate / Windows7 Office 2007 Ultimate / 2010 Professional |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find dupes, list in MsgBox with cell.address convert ws widecode to one sheet
On Sunday, May 25, 2014 8:54:41 AM UTC-7, Claus Busch wrote:
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. -- 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find dupes, list in MsgBox with cell.address convert ws wide code to one sheet
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find dupes, list in MsgBox with cell.address convert ws widecode to one sheet
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find dupes, list in MsgBox with cell.address convert ws wide code to one sheet
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find dupes, list in MsgBox with cell.address convert ws wide code to one sheet
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. -- Vista Ultimate / Windows7 Office 2007 Ultimate / 2010 Professional |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find dupes, list in MsgBox with cell.address convert ws wide code to one sheet
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. 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
MsgBox cell address | Excel Programming | |||
Returning a cell address in a msgbox, by selection via inputbox Ty | Excel Discussion (Misc queries) | |||
Convert street address to zip code | Excel Worksheet Functions | |||
Find Blank Cells and List Each Cell Address in Another Sheet | Excel Programming |