Play sound when duplicate value entered

dominicanderson

New Member
Joined
Nov 29, 2014
Messages
1
Hello, hopefully someone can help me with this request.

In column A I will be entering a list of product codes, without looking at the screen.

I want Excel to play a designated audio file when a duplicate value is entered, so I am alerted that it is a duplicate and can take appropriate action in real time.

Thank you!
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
This is event code for worksheet change event. The code will initialize for any changes made to the worksheet in which it is installed in the code module of that sheet. However, it will only execute the evaluation for duplicates and notification for changes made to a single cell in column A. To install the code, copy it into the sheet code module for the worksheet where you will be making the changes. To access the code module, right click the sheet name tab, then click 'View Code' in the pop up menu. Once the code is installed, close the VB editor window and save the workbook as a macro enabled workbook (.xlsm) to preserve the code when the workbook is closed.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
    If Target.Cells.Count > 1 Or Target = "" Then Exit Sub
    If Application.CountIf(Range("A:A"), Target.Value) > 1 Then
    cbt = 0
        Do
            Beep
            s = Timer + 0.2
                Do While Timer < s
                    DoEvents
                Loop
            cnt = cnt + 1
        Loop Until cnt = 2
        MsgBox "Duplicate entry"
    End If
End If
End Sub
 

L. Howard

Well-known Member
Joined
Oct 16, 2012
Messages
4,514
If you want more "racket" try this addition to JLGWhiz's code.

Code goes in the same place.

Howard


Code:
Private Declare Function sndPlaySound32 _
    Lib "winmm.dll" _
    Alias "sndPlaySoundA" ( _
        ByVal lpszSoundName As String, _
        ByVal uFlags As Long) As Long

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Dim cbt As Long, cnt As Long
Dim s As Double
    If Target.Cells.Count > 1 Or Target = "" Then Exit Sub
    If Application.CountIf(Range("A:A"), Target.Value) > 1 Then
    cbt = 0
        Do

            sndPlaySound32 "C:\Windows\Media\Chimes.wav", 0&
            Beep
            
            s = Timer + 0.2
                Do While Timer < s
                    DoEvents
                Loop
            cnt = cnt + 1
        Loop Until cnt = 2
        MsgBox "Duplicate entry"
    End If
End If
End Sub
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
If you want more "racket" try this addition to JLGWhiz's code.

Code goes in the same place.

Howard

Code:
Private Declare Function sndPlaySound32 _
    Lib "winmm.dll" _
    Alias "sndPlaySoundA" ( _
        ByVal lpszSoundName As String, _
        ByVal uFlags As Long) As Long

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Dim cbt As Long, cnt As Long
Dim s As Double
    If Target.Cells.Count > 1 Or Target = "" Then Exit Sub
    If Application.CountIf(Range("A:A"), Target.Value) > 1 Then
    cbt = 0
        Do

            sndPlaySound32 "C:\Windows\Media\Chimes.wav", 0&
            Beep
            
            s = Timer + 0.2
                Do While Timer < s
                    DoEvents
                Loop
            cnt = cnt + 1
        Loop Until cnt = 2
        MsgBox "Duplicate entry"
    End If
End If
End Sub
@Howard
Don't you need an End Function line on there?
 

L. Howard

Well-known Member
Joined
Oct 16, 2012
Messages
4,514

ADVERTISEMENT

@Howard
Don't you need an End Function line on there?


Code:
Private Declare Function sndPlaySound32 _
    Lib "winmm.dll" _
    Alias "sndPlaySoundA" ( _
    ByVal lpszSoundName As String, _
    ByVal uFlags As Long) As Long

Actually it is all one line of code.

Works on my sheet, although it does look strange.

Howard
 

L. Howard

Well-known Member
Joined
Oct 16, 2012
Messages
4,514
And at risk of to much information...

This has speech.

Howard


Code:
Option Explicit

Private Declare Function sndPlaySound32 Lib _
"winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Dim cbt As Long, cnt As Long
Dim s As Double
    If Target.Cells.Count > 1 Or Target = "" Then Exit Sub
    If Application.CountIf(Range("A:A"), Target.Value) > 1 Then
    cbt = 0
        Do
            sndPlaySound32 "C:\Windows\Media\Chimes.wav", 0&
            Application.Speech.Speak CStr(Target.Value) & " , , , ,The  last entry , ,is  a,  duplicate"
            Beep
            
            s = Timer + 0.2
                Do While Timer < s
                    DoEvents
                Loop
            cnt = cnt + 1
        Loop Until cnt = 1 '2
        MsgBox "Duplicate entry " & Target.Value
    End If
End If
End Sub
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,917

ADVERTISEMENT

You can do this with a UDF.
Put =IF(SUMPRODUCT(COUNTIF(A1:A1000, A1:A1000))=COUNTA(A1:A1000), "OK", MyBeep(A:A, "Duplicate Exists")) in a cell.

Code:
Function myBeep(Trigger As Variant, Optional retVal As String) As Variant
    If retVal = vbNullString Then
        myBeep = True
    Else
        myBeep = retVal
    End If
    Beep
End Function
 

L. Howard

Well-known Member
Joined
Oct 16, 2012
Messages
4,514
Hi Mike,

With the function in a standard module and the formula in cell B1, it returns a #VALUE! error and any entry, duplicate or not, in column A produces a "Bong" error sound.

Can you tell from that if I am doing something incorrect?

Howard
 
Last edited:

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,917
This worked for me

=IF(SUMPRODUCT(COUNTIF(A1:A1000, A1:A1000))=COUNTA(A1:A1000), "OK", MyBeep(A1, "Duplicate Exists"))

It took me a while to notice that I had copy pasted "in a cell" along with the formula.
 

L. Howard

Well-known Member
Joined
Oct 16, 2012
Messages
4,514
This worked for me

=IF(SUMPRODUCT(COUNTIF(A1:A1000, A1:A1000))=COUNTA(A1:A1000), "OK", MyBeep(A1, "Duplicate Exists"))

It took me a while to notice that I had copy pasted "in a cell" along with the formula.


Now that is funny, and :oops: and a big DUH on my part, LOL!

It works great if one can learn to copy and paste a formula without the accompanying text instructions.
Thanks Mike.

Howard
 

Watch MrExcel Video

Forum statistics

Threads
1,123,229
Messages
5,600,420
Members
414,383
Latest member
kevinlarey

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top