Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old February 8th, 2017, 09:18 AM
Registered User
 
Join Date: Feb 2017
Posts: 9
Thanks: 0
Thanked 1 Time in 1 Post
Default Finding & Deleting Duplicates

I have the following piece of code that finds duplicate listings in column A.
[Option Explicit
Sub Find_Duplicatel()
'Checks for duplicates in a column by highlighting it with a color.

Dim cel As Variant

Dim myrange As Range

Set myrange = Range("A5:A2003")



myrange.Interior.ColorIndex = xlNone



For Each cel In myrange

If Application.WorksheetFunction.CountIf(myrange, cel) > 1 Then

cel.Interior.ColorIndex = 4

End If

Next

End Sub]
Currently it highlights the cells that are duplicates. However after I delete one of the duplicate cells, the other cell that was a duplicate remains highlighted. What I am trying to do has 4 steps.
1. Find & highlight the duplicate.
2. Ask the user if they want to make a change to the record.
3. Make the change if the user wants & have the previous cell that was highlighted, return to normal.
4. If the user chooses to not make any changes, then it remains the same.
If there is another way to doing this, I am open to suggestions.
 
Old February 9th, 2017, 09:59 AM
Registered User
 
Join Date: Feb 2017
Posts: 9
Thanks: 0
Thanked 1 Time in 1 Post
Default Finding duplicates & orrecting

I found the following code on the ENCODEDNA website & after modifying it for my worksheet, it works exactly as I expected.
[Sub FIND_DUPLICATE()

Option Explicit

Dim myDataRng As Range
Dim cell As Range

' WE WILL SET THE RANGE (FIRST COLUMN).
Set myDataRng = Range("A1:A" & Cells(Rows.Count, "B").End(xlUp).Row)

For Each cell In myDataRng
cell.Offset(0, 0).Font.Color = vbBlack ' DEFAULT COLOR.

' LOCATE DUPLICATE VALUE(S) IN THE SPECIFIED RANGE OF DATA.
If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," &
cell.Address & ")") > 1 Then
cell.Offset(0, 0).Font.Color = vbRed ' CHANGE FORE COLOR TO
RED.
End If
Next cell

Set myDataRng = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub]
Is it possible to add code to:
1. Ask the user if they want to make a change to the record, after it has been highlighted.
2. If the user chooses to not make any changes, then it remains the same.
(Yes No code would probably work if #3, can be solved.
3. Make the change if the user wants & have the previous cell that was highlighted, return to normal.
 
Old February 10th, 2017, 01:24 AM
Authorized User
 
Join Date: Oct 2015
Posts: 48
Thanks: 0
Thanked 5 Times in 5 Posts
Smile

For your current function: Call on change and re-run the search and highlight function again.

Even better:
Instead of using the Excel countif function, use the vba find/findNext function, save to array if matched. Return this array. Then feed this array to the one that takes action on duplicates. The one that takes action will then remove the entry from the duplicates array.
You could use the union instead of an array.

In simple terms = separation of concerns.
__________________
Nostalgia 4 Infinity
 
Old February 10th, 2017, 03:13 PM
Registered User
 
Join Date: Feb 2017
Posts: 9
Thanks: 0
Thanked 1 Time in 1 Post
Talking

I reached out & have gotten assistance.
Here is the working code:
[Option Explicit

Sub FIND_DUPLICATE()

Dim myDataRng As Range
Dim cell As Range
Dim strV As String

' Use column A
Set myDataRng = Range(Range("A1"), Cells(Rows.Count, "A").End(xlUp))

For Each cell In myDataRng
If Application.CountIf(Range(Range("A1"), cell), cell.Value) > 1 Then
strV = cell.Value
If MsgBox("""" & strV & """ has already appeared above. Delete duplicates?", vbYesNo) = vbYes Then
cell.ClearContents
While Application.CountIf(myDataRng, strV) > 1
myDataRng.find(strV, cell, xlValues, xlWhole, , xlNext).ClearContents
Wend
End If
End If
Next cell

End Sub]





Similar Threads
Thread Thread Starter Forum Replies Last Post
SharePoint Themes / Finding & Installing rubix BOOK: Professional Microsoft Office SharePoint Designer 2007 ISBN: 978-0-470-28761-3 0 November 15th, 2010 02:31 PM
Updating & Deleting Rows from a Repeater saturdave ASP.NET 1.0 and 1.1 Basics 4 February 19th, 2004 04:35 PM
Automatically Finding and Deleting Blank rows Romulus Excel VBA 3 October 18th, 2003 09:04 PM
Deleting duplicates prabodh_mishra SQL Server 2000 3 September 23rd, 2003 09:04 AM
Deleting Duplicates ioates SQL Server 2000 5 August 31st, 2003 10:18 AM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.