Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
Pat
 
Posts: n/a
Default 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   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson
 
Posts: n/a
Default 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   Report Post  
Posted to microsoft.public.excel.misc
Pat
 
Posts: n/a
Default 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   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson
 
Posts: n/a
Default 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   Report Post  
Posted to microsoft.public.excel.misc
Pat
 
Posts: n/a
Default 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   Report Post  
Posted to microsoft.public.excel.misc
Pat
 
Posts: n/a
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On



All times are GMT +1. The time now is 06:59 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"