Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("B10:B19, B25:B34, B40:B49")) Is Nothing Then Target.Offset(0, 4).Value = "CONTROLLATO" Target.Offset(0, 4).Font.ColorIndex = 3 Cancel = True End If End Sub
Option Explicit Private Sub worksheet_beforedoubleclick(ByVal target As Range, cancel As Boolean) If Intersect(target, Range(" B10:B19, B25: B34, B40:B49")) Is Nothing Then Exit Sub On Error Resume Next Application.ScreenUpdating = False Cells(target.Row, "F") = "Controllare" Cells(target.Row, "F").Font.Color = -16776961 Application.ScreenUpdating = True End Sub