Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Finding and marking duplicates
I've got a worksheet which contains several lists with numbers
(different ranges), which I want to verify and mark for duplicates. Now if I use the 'find all' function from excel, the popup shows a list of cells which correspond to the looked up value. I want to use that result in my code to decide, if there is more than 1 match. But I have no clue, on how to access that information. If I do the following 'IF - THEN' statement (just a littel testversion - and for all you hard core programmers out the I'm a bloody beginner, so please excuse if its not state of the art), its checking for the looked up value rather than the instances: Sub MarkDuplicates() Cycles = 600 CI = 3 OS = 0 Range("DataArea").Select LV = ActiveCell() For j = 1 To Cycles If Selection.Find(What:=LV) 1 Then Application.ReplaceFormat.Interior.ColorIndex = CI Selection.Replace What:=LV, Replacement:="", LookAt:=xlWhole, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=True CI = CI + 1 End If OS = OS + 1 LV = ActiveCell.Offset(OS, 0) Next j End Sub Can You please help me out and let me know, how I can solve this task? thanks in advance for any sugestions. :-) |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Finding and marking duplicates
I'm not quite sure what you're doing, but that list that you get from a
Edit|FindAll isn't available via code. But it looks like you may be able to use format|Conditional formatting to highlight your range for duplicates. But you're also clearing the cells that contain the duplicate value. I'd approach it something like: Option Explicit Sub MarkDuplicates() Dim FoundCell As Range Dim ValueToFind As Variant Dim RngToCheck As Range Dim CI As Long CI = 3 With ActiveSheet ValueToFind = ActiveCell.Value 'or be specific 'ValueToFind = .Range("a1").Value Set RngToCheck = .Range("DataArea") End With If ValueToFind = "" Then Exit Sub End If Do With RngToCheck Set FoundCell = .Cells.Find(what:=ValueToFind, _ after:=.Cells(.Cells.Count), LookIn:=xlValues, _ lookat:=xlWhole, MatchCase:=False) End With If FoundCell Is Nothing Then Exit Do 'no more to do End If With FoundCell .ClearContents .Interior.ColorIndex = CI End With Loop End Sub Pat wrote: I've got a worksheet which contains several lists with numbers (different ranges), which I want to verify and mark for duplicates. Now if I use the 'find all' function from excel, the popup shows a list of cells which correspond to the looked up value. I want to use that result in my code to decide, if there is more than 1 match. But I have no clue, on how to access that information. If I do the following 'IF - THEN' statement (just a littel testversion - and for all you hard core programmers out the I'm a bloody beginner, so please excuse if its not state of the art), its checking for the looked up value rather than the instances: Sub MarkDuplicates() Cycles = 600 CI = 3 OS = 0 Range("DataArea").Select LV = ActiveCell() For j = 1 To Cycles If Selection.Find(What:=LV) 1 Then Application.ReplaceFormat.Interior.ColorIndex = CI Selection.Replace What:=LV, Replacement:="", LookAt:=xlWhole, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=True CI = CI + 1 End If OS = OS + 1 LV = ActiveCell.Offset(OS, 0) Next j End Sub Can You please help me out and let me know, how I can solve this task? thanks in advance for any sugestions. :-) -- Dave Peterson |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Finding and marking duplicates
Hi Dave,
thanks for Your reply. But it is not actually what I need to do: I have chunks of numbers distributed over a worksheet which I grouped with a named area. That data is not static, but will be overwritten quite frequently (manually). Below an excerpt of some of the data: 21 105 264 438 113 212 217 105 166 183 166 183 217 21 113 212 217 438 What I need is a function which checks all the numbers in the named range for duplicates and highlights those duplicates (not delete, not clear, just highlite), preferably with different colors. Means, all 21's with red background, all 217's with yellow and so on. Dave Peterson wrote: I'm not quite sure what you're doing, but that list that you get from a Edit|FindAll isn't available via code. But it looks like you may be able to use format|Conditional formatting to highlight your range for duplicates. But you're also clearing the cells that contain the duplicate value. I'd approach it something like: Option Explicit Sub MarkDuplicates() Dim FoundCell As Range Dim ValueToFind As Variant Dim RngToCheck As Range Dim CI As Long CI = 3 With ActiveSheet ValueToFind = ActiveCell.Value 'or be specific 'ValueToFind = .Range("a1").Value Set RngToCheck = .Range("DataArea") End With If ValueToFind = "" Then Exit Sub End If Do With RngToCheck Set FoundCell = .Cells.Find(what:=ValueToFind, _ after:=.Cells(.Cells.Count), LookIn:=xlValues, _ lookat:=xlWhole, MatchCase:=False) End With If FoundCell Is Nothing Then Exit Do 'no more to do End If With FoundCell .ClearContents .Interior.ColorIndex = CI End With Loop End Sub Pat wrote: I've got a worksheet which contains several lists with numbers (different ranges), which I want to verify and mark for duplicates. Now if I use the 'find all' function from excel, the popup shows a list of cells which correspond to the looked up value. I want to use that result in my code to decide, if there is more than 1 match. But I have no clue, on how to access that information. If I do the following 'IF - THEN' statement (just a littel testversion - and for all you hard core programmers out the I'm a bloody beginner, so please excuse if its not state of the art), its checking for the looked up value rather than the instances: Sub MarkDuplicates() Cycles = 600 CI = 3 OS = 0 Range("DataArea").Select LV = ActiveCell() For j = 1 To Cycles If Selection.Find(What:=LV) 1 Then Application.ReplaceFormat.Interior.ColorIndex = CI Selection.Replace What:=LV, Replacement:="", LookAt:=xlWhole, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=True CI = CI + 1 End If OS = OS + 1 LV = ActiveCell.Offset(OS, 0) Next j End Sub Can You please help me out and let me know, how I can solve this task? thanks in advance for any sugestions. :-) -- Dave Peterson |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Finding and marking duplicates
Personally, I'd use another column and put a formula like:
=countif($a$2:$A$100,a2) (with headers in A1) and drag down Then I could filter by that extra column. Shading is nice to look at, but there's really not much built into excel that will help you process those indicator colors. But if you want, find out the numbers that represent the colors that you want. If you don't supply enough colorindexes, the program will loop around and reuse those colors. Option Explicit Sub testme() Dim CurWks As Worksheet Dim TempWks As Worksheet Dim myInputRange As Range Dim myInputArea As Range Dim myCol As Range Dim FoundCell As Range Dim myCell As Range Dim myColors As Variant Dim cCtr As Long Dim FirstAddress As String Dim DestCell As Range Set CurWks = Worksheets("sheet1") Set TempWks = Worksheets.Add 'give it enough numbers--else it recycles the colors myColors = Array(3, 5, 12, 18, 22, 17) With CurWks Set myInputRange = .Range("myRange") End With myInputRange.Interior.ColorIndex = xlNone Set DestCell = TempWks.Range("a2") For Each myInputArea In myInputRange.Areas For Each myCol In myInputArea.Columns myCol.Copy _ Destination:=DestCell 'prepare for the next time With TempWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next myCol Next myInputArea With TempWks .Range("a1").Value = "UniqueHeaderValueHere" With .Range("a1", .Cells(.Rows.Count, "A").End(xlUp)) .Sort key1:=.Columns(1), order1:=xlAscending, _ header:=xlYes .AdvancedFilter action:=xlFilterCopy, _ copytorange:=.Cells(1).Offset(0, 1), unique:=True End With With .Range("b2", .Cells(.Rows.Count, "b").End(xlUp)) With .Offset(0, 1) .Formula = "=countif(a:a,b2)" .Value = .Value End With cCtr = LBound(myColors) For Each myCell In .Cells FirstAddress = "" If myCell.Offset(0, 1).Value 1 Then With myInputRange Set FoundCell = .Cells.Find(what:=myCell.Value, _ LookIn:=xlValues, lookat:=xlWhole, _ searchorder:=xlByRows, _ searchdirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then 'something bad happened! Else FirstAddress = FoundCell.Address Do FoundCell.Interior.ColorIndex = myColors(cCtr) Set FoundCell = .FindNext(after:=FoundCell) Loop While FoundCell.Address < FirstAddress End If End With cCtr = cCtr + 1 If cCtr UBound(myColors) Then cCtr = LBound(myColors) End If End If Next myCell End With End With Application.DisplayAlerts = False 'TempWks.Delete Application.DisplayAlerts = True End Sub This routine copies each column of each area in the range named myRange to a new sheet in column A. It sorts that copied data and does data|filter|advanced filter to get a list of unique values in column B. Then it adds a formula in column c that counts how many times each unique value appears. Then it goes through this list to find quantities larger than 1 (no singletons). And it goes back to your original data and starts assigning colors to each of those cells in that range that has each of those values. ps. At the top of the routine, it clears any existing colors. And I commented this line: 'TempWks.Delete If you don't want to see that temporary worksheet (to double check stuff), you can just remove that apostrophe. Again, I think colors are pretty, but they're not really too useful. I like to do stuff that I can use later (like with filters). ======= And if you want to read about more ideas working with duplicates, visit Chip Pearson's site: http://www.cpearson.com/excel/duplicat.htm Pat wrote: Hi Dave, thanks for Your reply. But it is not actually what I need to do: I have chunks of numbers distributed over a worksheet which I grouped with a named area. That data is not static, but will be overwritten quite frequently (manually). Below an excerpt of some of the data: 21 105 264 438 113 212 217 105 166 183 166 183 217 21 113 212 217 438 What I need is a function which checks all the numbers in the named range for duplicates and highlights those duplicates (not delete, not clear, just highlite), preferably with different colors. Means, all 21's with red background, all 217's with yellow and so on. Dave Peterson wrote: I'm not quite sure what you're doing, but that list that you get from a Edit|FindAll isn't available via code. But it looks like you may be able to use format|Conditional formatting to highlight your range for duplicates. But you're also clearing the cells that contain the duplicate value. I'd approach it something like: Option Explicit Sub MarkDuplicates() Dim FoundCell As Range Dim ValueToFind As Variant Dim RngToCheck As Range Dim CI As Long CI = 3 With ActiveSheet ValueToFind = ActiveCell.Value 'or be specific 'ValueToFind = .Range("a1").Value Set RngToCheck = .Range("DataArea") End With If ValueToFind = "" Then Exit Sub End If Do With RngToCheck Set FoundCell = .Cells.Find(what:=ValueToFind, _ after:=.Cells(.Cells.Count), LookIn:=xlValues, _ lookat:=xlWhole, MatchCase:=False) End With If FoundCell Is Nothing Then Exit Do 'no more to do End If With FoundCell .ClearContents .Interior.ColorIndex = CI End With Loop End Sub Pat wrote: I've got a worksheet which contains several lists with numbers (different ranges), which I want to verify and mark for duplicates. Now if I use the 'find all' function from excel, the popup shows a list of cells which correspond to the looked up value. I want to use that result in my code to decide, if there is more than 1 match. But I have no clue, on how to access that information. If I do the following 'IF - THEN' statement (just a littel testversion - and for all you hard core programmers out the I'm a bloody beginner, so please excuse if its not state of the art), its checking for the looked up value rather than the instances: Sub MarkDuplicates() Cycles = 600 CI = 3 OS = 0 Range("DataArea").Select LV = ActiveCell() For j = 1 To Cycles If Selection.Find(What:=LV) 1 Then Application.ReplaceFormat.Interior.ColorIndex = CI Selection.Replace What:=LV, Replacement:="", LookAt:=xlWhole, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=True CI = CI + 1 End If OS = OS + 1 LV = ActiveCell.Offset(OS, 0) Next j End Sub Can You please help me out and let me know, how I can solve this task? thanks in advance for any sugestions. :-) -- Dave Peterson -- Dave Peterson |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
Finding and marking duplicates
I might have to clarify one more point: I don't just need the
duplicates highlighted, but also the first entry. so, if there should be 3 times the value 21, I need them all highlighted, not just the last two. Sorry for not beeing precise enough the first time! :-) Pat wrote: Hi Dave, thanks for Your reply. But it is not actually what I need to do: I have chunks of numbers distributed over a worksheet which I grouped with a named area. That data is not static, but will be overwritten quite frequently (manually). Below an excerpt of some of the data: 21 105 264 438 113 212 217 105 166 183 166 183 217 21 113 212 217 438 What I need is a function which checks all the numbers in the named range for duplicates and highlights those duplicates (not delete, not clear, just highlite), preferably with different colors. Means, all 21's with red background, all 217's with yellow and so on. Dave Peterson wrote: I'm not quite sure what you're doing, but that list that you get from a Edit|FindAll isn't available via code. But it looks like you may be able to use format|Conditional formatting to highlight your range for duplicates. But you're also clearing the cells that contain the duplicate value. I'd approach it something like: Option Explicit Sub MarkDuplicates() Dim FoundCell As Range Dim ValueToFind As Variant Dim RngToCheck As Range Dim CI As Long CI = 3 With ActiveSheet ValueToFind = ActiveCell.Value 'or be specific 'ValueToFind = .Range("a1").Value Set RngToCheck = .Range("DataArea") End With If ValueToFind = "" Then Exit Sub End If Do With RngToCheck Set FoundCell = .Cells.Find(what:=ValueToFind, _ after:=.Cells(.Cells.Count), LookIn:=xlValues, _ lookat:=xlWhole, MatchCase:=False) End With If FoundCell Is Nothing Then Exit Do 'no more to do End If With FoundCell .ClearContents .Interior.ColorIndex = CI End With Loop End Sub Pat wrote: I've got a worksheet which contains several lists with numbers (different ranges), which I want to verify and mark for duplicates. Now if I use the 'find all' function from excel, the popup shows a list of cells which correspond to the looked up value. I want to use that result in my code to decide, if there is more than 1 match. But I have no clue, on how to access that information. If I do the following 'IF - THEN' statement (just a littel testversion - and for all you hard core programmers out the I'm a bloody beginner, so please excuse if its not state of the art), its checking for the looked up value rather than the instances: Sub MarkDuplicates() Cycles = 600 CI = 3 OS = 0 Range("DataArea").Select LV = ActiveCell() For j = 1 To Cycles If Selection.Find(What:=LV) 1 Then Application.ReplaceFormat.Interior.ColorIndex = CI Selection.Replace What:=LV, Replacement:="", LookAt:=xlWhole, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=True CI = CI + 1 End If OS = OS + 1 LV = ActiveCell.Offset(OS, 0) Next j End Sub Can You please help me out and let me know, how I can solve this task? thanks in advance for any sugestions. :-) -- Dave Peterson |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
Finding and marking duplicates
Thanks for Your reply. Can't use the idea of another column due to the
fact, that the values are linked to other data which I need to refer back to. But I will try it with the routine you provided and see, if i get the results I need. Thanks so far, I'll be back to post the results ;-) Dave Peterson wrote: Personally, I'd use another column and put a formula like: =countif($a$2:$A$100,a2) (with headers in A1) and drag down Then I could filter by that extra column. Shading is nice to look at, but there's really not much built into excel that will help you process those indicator colors. But if you want, find out the numbers that represent the colors that you want. If you don't supply enough colorindexes, the program will loop around and reuse those colors. Option Explicit Sub testme() Dim CurWks As Worksheet Dim TempWks As Worksheet Dim myInputRange As Range Dim myInputArea As Range Dim myCol As Range Dim FoundCell As Range Dim myCell As Range Dim myColors As Variant Dim cCtr As Long Dim FirstAddress As String Dim DestCell As Range Set CurWks = Worksheets("sheet1") Set TempWks = Worksheets.Add 'give it enough numbers--else it recycles the colors myColors = Array(3, 5, 12, 18, 22, 17) With CurWks Set myInputRange = .Range("myRange") End With myInputRange.Interior.ColorIndex = xlNone Set DestCell = TempWks.Range("a2") For Each myInputArea In myInputRange.Areas For Each myCol In myInputArea.Columns myCol.Copy _ Destination:=DestCell 'prepare for the next time With TempWks Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next myCol Next myInputArea With TempWks .Range("a1").Value = "UniqueHeaderValueHere" With .Range("a1", .Cells(.Rows.Count, "A").End(xlUp)) .Sort key1:=.Columns(1), order1:=xlAscending, _ header:=xlYes .AdvancedFilter action:=xlFilterCopy, _ copytorange:=.Cells(1).Offset(0, 1), unique:=True End With With .Range("b2", .Cells(.Rows.Count, "b").End(xlUp)) With .Offset(0, 1) .Formula = "=countif(a:a,b2)" .Value = .Value End With cCtr = LBound(myColors) For Each myCell In .Cells FirstAddress = "" If myCell.Offset(0, 1).Value 1 Then With myInputRange Set FoundCell = .Cells.Find(what:=myCell.Value, _ LookIn:=xlValues, lookat:=xlWhole, _ searchorder:=xlByRows, _ searchdirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then 'something bad happened! Else FirstAddress = FoundCell.Address Do FoundCell.Interior.ColorIndex = myColors(cCtr) Set FoundCell = .FindNext(after:=FoundCell) Loop While FoundCell.Address < FirstAddress End If End With cCtr = cCtr + 1 If cCtr UBound(myColors) Then cCtr = LBound(myColors) End If End If Next myCell End With End With Application.DisplayAlerts = False 'TempWks.Delete Application.DisplayAlerts = True End Sub This routine copies each column of each area in the range named myRange to a new sheet in column A. It sorts that copied data and does data|filter|advanced filter to get a list of unique values in column B. Then it adds a formula in column c that counts how many times each unique value appears. Then it goes through this list to find quantities larger than 1 (no singletons). And it goes back to your original data and starts assigning colors to each of those cells in that range that has each of those values. ps. At the top of the routine, it clears any existing colors. And I commented this line: 'TempWks.Delete If you don't want to see that temporary worksheet (to double check stuff), you can just remove that apostrophe. Again, I think colors are pretty, but they're not really too useful. I like to do stuff that I can use later (like with filters). ======= And if you want to read about more ideas working with duplicates, visit Chip Pearson's site: http://www.cpearson.com/excel/duplicat.htm Pat wrote: Hi Dave, thanks for Your reply. But it is not actually what I need to do: I have chunks of numbers distributed over a worksheet which I grouped with a named area. That data is not static, but will be overwritten quite frequently (manually). Below an excerpt of some of the data: 21 105 264 438 113 212 217 105 166 183 166 183 217 21 113 212 217 438 What I need is a function which checks all the numbers in the named range for duplicates and highlights those duplicates (not delete, not clear, just highlite), preferably with different colors. Means, all 21's with red background, all 217's with yellow and so on. Dave Peterson wrote: I'm not quite sure what you're doing, but that list that you get from a Edit|FindAll isn't available via code. But it looks like you may be able to use format|Conditional formatting to highlight your range for duplicates. But you're also clearing the cells that contain the duplicate value. I'd approach it something like: Option Explicit Sub MarkDuplicates() Dim FoundCell As Range Dim ValueToFind As Variant Dim RngToCheck As Range Dim CI As Long CI = 3 With ActiveSheet ValueToFind = ActiveCell.Value 'or be specific 'ValueToFind = .Range("a1").Value Set RngToCheck = .Range("DataArea") End With If ValueToFind = "" Then Exit Sub End If Do With RngToCheck Set FoundCell = .Cells.Find(what:=ValueToFind, _ after:=.Cells(.Cells.Count), LookIn:=xlValues, _ lookat:=xlWhole, MatchCase:=False) End With If FoundCell Is Nothing Then Exit Do 'no more to do End If With FoundCell .ClearContents .Interior.ColorIndex = CI End With Loop End Sub Pat wrote: I've got a worksheet which contains several lists with numbers (different ranges), which I want to verify and mark for duplicates. Now if I use the 'find all' function from excel, the popup shows a list of cells which correspond to the looked up value. I want to use that result in my code to decide, if there is more than 1 match. But I have no clue, on how to access that information. If I do the following 'IF - THEN' statement (just a littel testversion - and for all you hard core programmers out the I'm a bloody beginner, so please excuse if its not state of the art), its checking for the looked up value rather than the instances: Sub MarkDuplicates() Cycles = 600 CI = 3 OS = 0 Range("DataArea").Select LV = ActiveCell() For j = 1 To Cycles If Selection.Find(What:=LV) 1 Then Application.ReplaceFormat.Interior.ColorIndex = CI Selection.Replace What:=LV, Replacement:="", LookAt:=xlWhole, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=True CI = CI + 1 End If OS = OS + 1 LV = ActiveCell.Offset(OS, 0) Next j End Sub Can You please help me out and let me know, how I can solve this task? thanks in advance for any sugestions. :-) -- Dave Peterson -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|