Solved

Find and display in MsgBox Duplicate Values from a Range with VBA in Excel

Posted on 2011-02-28
20
1,273 Views
Last Modified: 2012-05-11
How do I check for duplicates in a one-dimension array?  I need to then return this value via a MessageBox to the User.  I do NOT want to delete the row, only find it and let the user know there is a duplicate that needs to be corrected.  This is to bedone in VBA.  So, if my range name is "RangeName", then what?  I have looked at some of the examples, but they delete the row and that is not what I want.
0
Comment
Question by:ssmith94015
  • 8
  • 7
  • 5
20 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35000890
ssmith94015: Do you want the list in an array or a string will do?

Sid
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 35000927
This code looks at the non blank entries in column A of the existing sheet for dupes using the Dictionary object. A string msgbox returns the dup value and cell position in a list

Altenatively my Dup Master addin does the work for you,http://www.experts-exchange.com/A_2123.html

Cheers

Dave
Sub GetDupes()
    Dim rng1 As Range
    Dim C As Range
    Dim objDic
    Dim strMsg As String

    Set objDic = CreateObject("scripting.dictionary")
    Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
    For Each C In rng1
        If Len(C.Value) > 0 Then
            If Not objDic.exists(C.Value) Then
                objDic.Add C.Value, 1
            Else
                strMsg = strMsg & C.Value & " in cell " & C.Address(0, 0) & vbNewLine
            End If
        End If
    Next
    If Len(strMsg) > 0 Then MsgBox strMsg
End Sub

Open in new window

0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35000932
Try this

Option Explicit
 
Sub DeleteDups()
    Dim x               As Long
    Dim LastRow         As Long
    Dim Myarray()       As String
    Dim countDups       As Long
    Dim strDups         As String
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    countDups = 1
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("A1:A" & LastRow), Range("A" & x).Text) > 1 Then
            ReDim Preserve Myarray(countDups)
            Myarray(countDups) = Range("A" & x).Text & ", " & Range("A" & x).Address
            countDups = countDups + 1
        End If
    Next x
    
    For x = LBound(Myarray) To UBound(Myarray)
        strDups = strDups & vbCrLf & Myarray(x)
    Next
    
    MsgBox strDups
End Sub

Open in new window


Sid
0
 

Author Comment

by:ssmith94015
ID: 35000976
Sid, in this procedure, having the results returned to a message box if all that is needed.  I found the below code as an example, but I do not know how to get it to look at each cell.  For further clarification, the value to be checked and the range name are first passed from a form.  Before the data is recorded on the woksheet, it must pass this check.  If there is a duplicate, the user is prevented from saving the information until the duplicate data entry is resolved.

Dave, not sure about creating a script so I have to admit that confuses me a bit.  Also, it is checking a range, not the column as two ranges could have the same data, but one range cannot have duplciates within it.
Sub CheckForDups()
'Checks to see if Portfolio Code already exists
Dim strTempVal As String
Dim rngField    As Range
' Cycle through each value in column A on the data sheet to see if
' that value already exists.

    For Each rngField In ThisWorksheet.Worksheets("Settings").Range(strRangeName)
        If TmpRng.Range("A1").Value = strTempVal Then
            MsgBox "Warning. This value already exists.", vbCritical, "Duplicate Found"
            Exit Sub
        End If
    Next

End Sub

Open in new window

0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35000997
Try this

Option Explicit
 
Sub DeleteDups()
    Dim x               As Long
    Dim LastRow         As Long
    Dim strDups         As String
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("A1:A" & LastRow), Range("A" & x).Text) > 1 Then
            strDups = strDups & vbCrLf & Range("A" & x).Text & ", " & Range("A" & x).Address
        End If
    Next x
    
    MsgBox strDups
End Sub

Open in new window

0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35001011
BTW the above code will give you the duplicates and the cell address in Col A. Please amend it for realistic situations.

Sid
0
 

Author Comment

by:ssmith94015
ID: 35001053
Ok, this is where I get confused again.  If I have a range, would not the first column in the range be A?  I have attached some modificaitions so far and this is the actual code I am using.
Sub CheckForDups(strTempVal As String, strRangeName As String)
'Checks to see if Portfolio Code already exists
Dim celField   As Range
Dim rngTempRng  As Range
' Cycle through each value in column A on the data sheet to see if
' that value already exists.

    For Each celField In ThisWorksheet.Worksheets("Settings").Range(strRangeName)
        If Range("A1").Value = strTempVal Then
            MsgBox "Warning. This value already exists.", vbCritical, "Duplicate Found"
            Exit Sub
        End If
    Next

End Sub

Open in new window

0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 35001059
The notes in your sample code appear to state it works in column A as both my code and Sid's later example do. When looking for dupes it is worth checking that the cells are non blank, unless that is already catered for (the len check in my code)

So we may need more info on your scope if that isn't your intent, or to clarify your question

Your sample code does appear to look cell by cell for StrTempVal, whereas a much quicker way would be to run a Find on the potential duplicate range

Cheers

Dave
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 35001098
You would run your code like below, ie to check a range called "range1" which may be multi-column for "apples" can be done quickly with Find

Cheers

Dave
Sub Test()
Call CheckForDups("apple", "range1")
End Sub

Sub CheckForDups(strTempVal As String, strRangeName As String)
Dim rng1 As Range

Set rng1 = Range(strRangeName).Find(strtmpval, , xlValues, xlWhole)
If Not rng1 Is Nothing Then MsgBox "Warning. This value already exists.", vbCritical, "Duplicate Found"

End Sub

Open in new window

0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 35001108
Typo fixed
Sub Test()
Call CheckForDups("apple", "range1")
End Sub

Sub CheckForDups(strTempVal As String, strRangeName As String)
Dim rng1 As Range

Set rng1 = Range(strRangeName).Find(strTempVal, , xlValues, xlWhole)
If Not rng1 Is Nothing Then MsgBox "Warning. This value already exists.", vbCritical, "Duplicate Found"

End Sub

Open in new window

0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35001114
>> If I have a range, would not the first column in the range be A?

No Not necessarily. for example your range is "D1:D40" then it has nothing to do with col A.

Do you want to find all duplicates in a range or do you want to find the occurrence of 1 particular string in a range?

Sid
0
 

Author Comment

by:ssmith94015
ID: 35001131
the parjticular occurrance of a value.  that is, if the Port Code of "ABCEFG", Already exists, and the user enters "ABCEFS" in the form, before the data can  be saved, it must run through this duplicate check.  I have make some typo corrections and modifications,which are attached.
Public Function CheckForDups(strTempVal As String, strRangeName As String) As Boolean
'Checks to see if Portfolio Code already exists
Dim celField   As Range
Dim rngTempRng  As Range
' Cycle through each value in column on the data sheet to see if value already exists.

    For Each celField In ThisWorkbook.Worksheets("Settings").Range(strRangeName)
        If .Value = strTempVal Then
            MsgBox "Warning. This value " & strTempVal & " already exists.", vbCritical, "Duplicate Found"
            CheckForDups = True
            Exit Function
        End If
    Next
        CheckForDups = False
End Function

Open in new window

0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 35001155
My code in 35001108 already does this with your modified example

Cheers

Dave
0
 

Author Comment

by:ssmith94015
ID: 35001156
I keep getting a Compuile error, Invlaid or unqualified reference at the

 If .Value = strTempVal Then

 line
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 35001165
That is because Your code is missing a With

Pls use my code from 35001108 (now several comments up)
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35001170
If you need to just find whether a duplicate exists or not then Dave's code in ID: 35001108 will help you out but if you need all occurrences of the duplicates then there will be a different code.

Sid
0
 
LVL 50

Accepted Solution

by:
Dave Brett earned 500 total points
ID: 35001210
.. I see you have added a Boolean check. So now something like this.

The msgbox is redundant in the function as the boolean flag stored in CheckForDups , so you would run it like this

Cheers

Dave
Sub Test()
    If CheckForDups("apple", "range1") Then MsgBox "Warning. This value already exists.", vbCritical, "Duplicate Found"
End Sub

Function CheckForDups(strTempVal As String, strRangeName As String) As Boolean

    Dim rng1 As Range

    Set rng1 = Range(strRangeName).Find(strTempVal, , xlValues, xlWhole)
    CheckForDups = (Not rng1 Is Nothing)

End Function

Open in new window

0
 

Author Closing Comment

by:ssmith94015
ID: 35001237
Thank you both and Dave, that worked.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35001244
Here is a much faster code

Sub Test()
    If CheckForDups("Apple", Range(strRangeName)) = True Then
        MsgBox "It is a duplicate"
    Else
        MsgBox "It is not a duplicate"
    End If
End Sub

Function CheckForDups(strTempVal As String, Rng As Range) As Boolean
    If Application.WorksheetFunction.CountIf(Rng, strTempVal) > 1 Then _
    CheckForDups = True
End Function

Open in new window


Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35001250
Oops.. late for the party :)

Sid
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
User Beware!  This is a rather permanent solution to removing your email from an exchange server.  The only way to truly go back is to have your exchange administrator restore your mailbox from backups.  This is usually the option of last resort.  A…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now