Question for excel pro's.How to create user defined function that would sound an alarm once conditions are met.

[sid69]

I have an excel spreadsheet with a streaming temperatures data in a multiple cells.
I'm trying to create a user defined function that would sound an alarm when a temperature rises above specified value.This value is a parameter of this function.
So far I have this code...

Function BeepOnce(rng As Range, alarm_temperature As Single = 50)

If (rng.Cells.Value >= alarm_temperature) Then
BeepOnce = "Temperature is above specified vaule!"
Beep
Exit Function

End If
End Function


The problem is that I need to sound an alarm only once for every cell. Only when temperature rise above this value.

example:
temperature 1 in a cell A1 is 50. Once the temperature in a cell A1 rises above 60 (for example to 65) an alarm would sound(only once). When the temperature then rises again to (for example to 70), there would be no alarm.

temperature 2 in a cell A2 is 40 Once the temperature in a cell A2 rises above 50 (for example to 55) an alarm would sound(only once). When the temperature then rises again to (for example to 60), there would be no alarm.

Once the temperature decrease below specified value, alarm then rest itself.

 

[sid69]

Any ideas at all?

 

[shg]

In the sheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
  Const dAlarm      As Double = 50
  
  ' requires a reference to Microsoft Sripting Runtime
  Static dic        As Scripting.Dictionary
  
  Dim cell As Range

  If dic Is Nothing Then Set dic = New Scripting.Dictionary

  With dic
    For Each cell In Intersect(Target.Cells, Columns("A"), Me.UsedRange)
      If VarType(cell.Value2) = vbDouble Then
        If cell.Value >= dAlarm Then
          If Not .Exists(cell.Address) Then
            cell.Select
            .Add cell.Address, 0
            Beep
            MsgBox "Beep! Beep! Beep!"
          End If
        ElseIf cell.Value < dAlarm And .Exists(cell.Address) Then
          .Remove cell.Address
        End If
      End If
    Next cell
  End With
End Sub

 

[Jaafar Tribak]

Alternatively, you could keep all code within the UDF as follows :

Function BeepOnce(rng As Range, Optional alarm_temperature As Single = 50)

    On Error Resume Next
    If (rng.Value >= alarm_temperature) Then
        BeepOnce = "Temperature is above specified vaule!"
        If GetSetting("BeepUDF", "alarm", rng.Address(, , , True)) = "" Then
            SaveSetting "BeepUDF", "alarm", rng.Address(, , , True), "Beep"
            Beep
        End If
    Else
        DeleteSetting "BeepUDF", "alarm", rng.Address(, , , True)
        BeepOnce = "Temperature is below specified vaule!"
    End If

End Function

 

[sid69]

In the sheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
  Const dAlarm      As Double = 50
  
  ' requires a reference to Microsoft Sripting Runtime
  Static dic        As Scripting.Dictionary
  
  Dim cell As Range

  If dic Is Nothing Then Set dic = New Scripting.Dictionary

  With dic
    For Each cell In Intersect(Target.Cells, Columns("A"), Me.UsedRange)
      If VarType(cell.Value2) = vbDouble Then
        If cell.Value >= dAlarm Then
          If Not .Exists(cell.Address) Then
            cell.Select
            .Add cell.Address, 0
            Beep
            MsgBox "Beep! Beep! Beep!"
          End If
        ElseIf cell.Value < dAlarm And .Exists(cell.Address) Then
          .Remove cell.Address
        End If
      End If
    Next cell
  End With
End Sub

Thank you for your code. The biggest issue with this code for me is that the temperature is a constant for all cells. I'm looking for a user defined temperatures for each cell. Also there was an error when I deleted cells with temperatures.
But thank very much you for trying anyway.

 

[sid69]

Alternatively, you could keep all code within the UDF as follows :

Function BeepOnce(rng As Range, Optional alarm_temperature As Single = 50)

    On Error Resume Next
    If (rng.Value >= alarm_temperature) Then
        BeepOnce = "Temperature is above specified vaule!"
        If GetSetting("BeepUDF", "alarm", rng.Address(, , , True)) = "" Then
            SaveSetting "BeepUDF", "alarm", rng.Address(, , , True), "Beep"
            Beep
        End If
    Else
        DeleteSetting "BeepUDF", "alarm", rng.Address(, , , True)
        BeepOnce = "Temperature is below specified vaule!"
    End If

End Function

WOW, you are a real excel PRO!.This is IT. This is exactly what I was looking for. THANK YOU VERY MUCH. I've almost lost all hope that this is possible to do .