Playing a sound on cell value

[graemeal]

I have an automated sort descend happening all day. The top several cells are coloured green and if a cell jumps to the top from below the green cells, I would love a warning sound. Is is possible to activate a sound if a cell changes from a colour to a non colour. Preferably if any of the cells within a range of say F2: F6 changes from green to a non colour.

If it is not possible to have a change of colour to activate the macro, I could get around it by - if any cells in a range of H2:H5 >than 1 it plays a sound

Cheers

XP XL2003

 

[graemeal]

Thanks again. you are a genius(well compared to me)

Much appreciated

 

[graemeal]

Sound wav being triggered without a keystroke.

I needed a sound wav to be activated by a change in any cell between a range of F2:F6. VoG was kind enough to supply me with the below code that does exactly what I asked. But as usual, nothing is as simple as first thought.

The sound wav is activated by a change in any of the cells between F2:F6, but only by way of a keystroke it seems, namely the enter key when entering a figure. If the cells change value without the help of a keystroke it doesn't trigger the sound wav

"obvious example". If I have a formula stating =B2 in the F2 cell and then change the value in B2, it won't trigger the sound .wav. But physically entering the same value in F2 and pressing "enter" does.

Is there a way to overcome this problem? something stating if any cell between F2:F6 is =1 or >1 would do the trick, but maybe that is also reliant on an enter keystroke to activate the sound. Thanks

Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long
 
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000

Private Sub Worksheet_Change(ByVal Target As Range)
Const FName As String = "C:\Intel.wav"
If Not Intersect(Target, Range("F2:F6")) Is Nothing Then
    Call PlaySound(FName, 0&, SND_ASYNC Or SND_FILENAME)
End If
End Sub

 

[VoG]

Try this

Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long
 
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000

Private Sub Worksheet_Calculate()
Const FName As String = "C:\Intel.wav"
Dim c As Range
For Each c In Range("F2:F6")
    If c.Value >= 1 Then
        Call PlaySound(FName, 0&, SND_ASYNC Or SND_FILENAME)
        Exit Sub
    End If
Next c
End Sub

 

[graemeal]

Thanks again, looks great. That C2 entry was just an example of how it did not work. Is is possible to have the sound wav activate just by the cell change alone in F2:F6

My application is when a cell that now can have 1 in it jumps to the top from below F2:F6 by way of sort descend a sound is triggered, which may be I should have used as an example.

Thanks again. Probably the best xmas present I have had for awhile. will save me up to 30 hours a week staring at a screen.

Also at the risk of pushing the boundries the ideal function for me is if a sound could be played if 2 ranges in 2 columns were triggered. You did send me something but when I try it it comes up with "compile error, sub or function not defined and the "call playsound" is highlighted. But if all to hard what you have supplied is wonderful.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim FName As String
If Not Intersect(Target, Range("F2:F6")) Is Nothing Then
    FName = "C:\Intel.wav"
    Call PlaySound(FName, 0&, SND_ASYNC Or SND_FILENAME)
ElseIf Not Intersect(Target, Range("I7:I18")) Is Nothing Then
    FName = "C:\Tardis.wav"
    Call PlaySound(FName, 0&, SND_ASYNC Or SND_FILENAME)
End If
End Sub

 

[VoG]

You need to add the PlaySound code:

Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long
 
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000


Private Sub Worksheet_Change(ByVal Target As Range)
Dim FName As String
If Not Intersect(Target, Range("F2:F6")) Is Nothing Then
    FName = "C:\Intel.wav"
    Call PlaySound(FName, 0&, SND_ASYNC Or SND_FILENAME)
ElseIf Not Intersect(Target, Range("I7:I18")) Is Nothing Then
    FName = "C:\Tardis.wav"
    Call PlaySound(FName, 0&, SND_ASYNC Or SND_FILENAME)
End If
End Sub

 

[graemeal]

LAST QUESTION. Is it possible to have the sound activate on a cell change or >=1 only in F2:F6 rather than being entered via the c column? As I said I should have explained my application. The cell change is triggered by a figure rising from below from sort descend.

Merry Xmas

Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long
 
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000

Private Sub Worksheet_Calculate()
Const FName As String = "C:\Intel.wav"
Dim c As Range
For Each c In Range("F2:F6")
    If c.Value >= 1 Then
        Call PlaySound(FName, 0&, SND_ASYNC Or SND_FILENAME)
        Exit Sub
    End If
Next c
End Sub[code]

 

[VoG]

I don't know of an event that is specifically triggered by a sort. If you can include a cell containing a formula (just a simple one like =A1) within the range being sorted then I'm pretty sure that the sort will trigger a recalculation and cause the Calculate code to fire.

 

[graemeal]

Thanks again. No problems I can add a column here or there. I will play around with trying to include one with say 2 ranges. F2:F6 and say I7:I15 playing differant sounds for each range, with the new codes "being triggered by an entry in the C column". But this one fixes my ongoing drama. If I can add 2 ranges with 2 sounds just icing on the cake.

Thanks again

 

[graemeal]

2 ranges triggering 2 differant sound WAV

I have tried all week to add a second range trigger but have failed miserably. The below code works like a dream but is it possible to have 2 ranges triggering 2 differant sound wav.

As below For Each h In range("P2:P5")
If h Value >=1 Then the sound wav ringin is triggered.

But somehow add something like For Each i In Range("P6:P12")
If i Value >=1 Then another sound wav is triggered

Thanks

Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long
 
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
 
Private Sub Worksheet_Calculate()
Const FName As String = "C:\windows\media\ringin.wav"
Dim h As Range
For Each h In Range("P2:P5")
    If h.Value >= 1 Then
        Call PlaySound(FName, 0&, SND_ASYNC Or SND_FILENAME)
        Exit Sub
    End If
Next h
End Sub

XP XL2003

 

[VoG]

Try this - note that I changed the file names to test and other changes are highlighted in red:

Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long
 
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
 
Private Sub Worksheet_Calculate()
Const FName1 As String = "C:\intel.wav"
Const FName2 As String = "C:\tardis.wav"
Dim h As Range
For Each h In Range("P2:P5")
    If h.Value >= 1 Then
        Call PlaySound(FName1, 0&, SND_SYNC Or SND_FILENAME)
        Exit For
    End If
Next h
For Each h In Range("P6:P12")
    If h.Value >= 1 Then
        Call PlaySound(FName2, 0&, SND_SYNC Or SND_FILENAME)
        Exit For
    End If
Next h
End Sub