Solved

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

Posted on 2011-02-28
20
1,792 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Get MongoDB database support online, now!

At Percona’s web store you can order your MongoDB database support needs in minutes. No hassles, no fuss, just pick and click. Pay online with a credit card. Handle your MongoDB database support now!

 

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
 
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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

634 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