emails a msg when value change

[manuel_almeida]

hi,
i have this worksheet to control the samples i must collect.
when i double clic in a day runs this code.
i want that affects only the cells in the row where i clic.(now affects all the cells in the range)
thanks in advance and sorry about my english

Private Sub testaColheita()
   Dim FormulaRange As Range
   Dim numero As Integer
   Dim dataregisto As Integer
   Set FormulaRange = Me.Range("AI4:AI19")
 
  On Error GoTo EndMacro:
   
For Each formulacell In FormulaRange.Cells
       With formulacell
            If IsNumeric(.Value) = False Then
                MsgBox "Valor nao numerico"
           Else
Select Case .Value
    Case Is = 1, 6, 11, 16, 21, 26, 31, 36, 41, 46, 51, 56, 61, 66, 71, 76, 81, 86, 91, 96, 101, 106, 111, 116, 121, 126 
            'MsgBox "Colheita de Amostra (" & Cells(formulacell.Row, "A").Value & ")", vbInformation + vbOKOnly, "Alerta..."
       
           Call Mail_with_outlook2 ' envia email
            Application.EnableEvents = False
    Cells(formulacell.Row, "C").Value = Now() 'escreve a data
    formulacell.Offset(0, 1).Value = 0 ' zera o contador
            Application.EnableEvents = True
          
    Case Is = 2, 3, 4, 5, 7, 8, 9, 10, 12, 13, 14, 15, 17, 18, 19, 20, 22, 23, 24, 25, 27, 28, 29, 30, 32, 33, 34, 35, 37, 38, 39, 40, 42, 43, 44, 45, 47, 48, 49, 50, 52, 53, 54, 55, 57, 58, 59, 60
            
             Application.EnableEvents = False
            formulacell.Offset(0, 1).Value = formulacell.Offset(0, 1).Value + 1 'regista +1 no contador
            dataregisto = DateDiff("m", Cells(formulacell.Row, "C").Value, Now())
            MsgBox dataregisto
    Application.EnableEvents = True
    Case Else
        Exit Sub
    End Select
End If
End With
    Next formulacell
ExitMacro:
    Exit Sub
EndMacro:
    Application.EnableEvents = True

    MsgBox "Some Error occurred." _
         & vbLf & Err.number _
         & vbLf & Err.Description
End Sub