Play sound when duplicate value entered

[dominicanderson]

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!

 

[JLGWhiz]

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.

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]

If you want more "racket" try this addition to JLGWhiz's code.

Code goes in the same place.

Howard

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]

If you want more "racket" try this addition to JLGWhiz's code.

Code goes in the same place.

Howard

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]

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

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]

And at risk of to much information...

This has speech.

Howard

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]

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.

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]

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

 

[mikerickson]

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]

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