Play a sound with VBA if an error is found

Answers (6)

Reputation: 191

The following code is supported by both 32-bit and 64-bit systems:

#If Win64 Then
Private Declare PtrSafe Function sndPlaySound32 Lib "winmm.dll" _
                 Alias "sndPlaySoundA" (ByVal lpszSoundName _
                        As String, ByVal uFlags As Long) As Long
#Else
Private Declare Function sndPlaySound32 Lib "winmm.dll" _
                  Alias "sndPlaySoundA" (ByVal lpszSoundName _
                         As String, ByVal uFlags As Long) As Long
#End If

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Cell As Range
    Dim PlaySound As Boolean

    If Target.Column = 3 Then
        For Each Cell In Target
           If WorksheetFunction.IsNA(Cell.Value) Then
               PlaySound = True
           End If
        Next
        If PlaySound Then
            Call sndPlaySound32("C:\windows\media\chord.wav", 1)
        End If
    End If
End Sub

Upvotes: 0

Siddharth Rout

Reputation: 149315

You don't need API for this

You can use Beep as well.

Sub Sample()
    Beep
End Sub

Example

WAY 1

This code will run if there is change anywhere in the sheet

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell            As Range
    Dim CheckRange      As Range

    Set CheckRange = Range("C:C")

    For Each Cell In CheckRange
        If Cell.Text = "#N/A" Then
            Beep
            Exit For
        End If
    Next
End Sub

WAY 2

Alternative of above code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range

    For Each Cell In Columns(3)
        On Error Resume Next
        If CVErr(Cell) = CVErr(2042) Then
            Beep
            Exit For
        End If
        On Error GoTo 0
    Next
End Sub

Way 3

If you want the to check Col C only if there is a manual change anywhere in Col C

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range

    If Not Intersect(Target, Columns(3)) Is Nothing Then
        For Each Cell In Columns(3)
            On Error Resume Next
            If CVErr(Cell) = CVErr(2042) Then
                Beep
                Exit For
            End If
            On Error GoTo 0
        Next
    End If
End Sub

Way 4

If you want the to check a particular cell if there is a manual change in that cell

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range

    If Not Intersect(Target, Columns(3)) Is Nothing Then
        On Error Resume Next
        If CVErr(Target) = CVErr(2042) Then
            Beep
            Exit Sub
        End If
        On Error GoTo 0
    End If
End Sub

Way 5

Variation of Way 4

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range

    If Not Intersect(Target, Columns(3)) Is Nothing Then
        If Target.Text = "#N/A" Then
            Beep
            Exit Sub
        End If
    End If
End Sub

FOLLOWUP (Post Comments)

The active cell will be in column b, so it should check one right in column d – Sam Cousins 1 min ago

I guess you meant Col C and not Col D. You have to use Worksheet_SelectionChange for this

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Columns(2)) Is Nothing Then
        If Target.Offset(, 1).Text = "#N/A" Then
            Beep
        End If
    End If
End Sub

Upvotes: 10

Ripster

Reputation: 3595

Change Cell.Value to Cell.Text

If there is a formula error the cells value will be something along the lines of Error 2042 but your if statement is looking for the text "#N/A"

I also suggest using only the used range instead of the entire column since this will decrease the time it takes to run.

You can also exit the for immediately if an error is found.

Using Beep will not allow you to play any sound but it will make an audible sound and does not require an API call or the computer to have the specified audio file.

-EDIT- I just tested the code below and it appears to work correctly for me.

-EDIT2- Corrected code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range
    Dim CheckRange As Range

    Set CheckRange = Range(Cells(1, 3), Cells(ActiveSheet.UsedRange.Rows.Count, 3))
    For Each Cell In CheckRange
        If Cell.Text = "#N/A" Then
            Beep
            Exit For
        End If
    Next
End Sub

-EDIT3- Working copy of your original post

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)

    Dim Cell As Range
    Dim CheckRange As Range
    Dim PlaySound As Boolean

    Set CheckRange = Range(Cells(1, 3), Cells(ActiveSheet.UsedRange.Rows.Count, 3))
    For Each Cell In CheckRange
        If Cell.Text = "#N/A" Then
            PlaySound = True
            Exit For
        End If
    Next
    If PlaySound Then
        Call sndPlaySound32("C:\windows\media\chord.wav", 1)
    End If
End Sub

Upvotes: 1

user2063626

Reputation:

Just Paste the below code and run and see if it works...

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)

    Dim Cell As Range
    Dim PlaySound As Boolean

    If Target.Column = 3 Then
        For Each Cell In Target
            If WorksheetFunction.IsNA(Cell.Value) Then
                PlaySound = True
            End If
        Next

        If PlaySound Then
            Call sndPlaySound32("C:\windows\media\chord.wav", 1)
        End If

    End If
End Sub

Upvotes: 5

Doug Clarke

Reputation: 43

I think your If statement which checks the value of PlaySound should be inside your For loop. The way you have it written it will only make a noise if the last cell in CheckRange = "#N/A" because PlaySound will hold the last value assigned to it from the loop.

Upvotes: 0

Peter L.

Reputation: 7304

Try to replace with If PlaySound = True Then

Upvotes: 0

Play a sound with VBA if an error is found

Answers (6)

Related Questions