I don't really understand what you want but try this
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("P:P")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
'Turn off events to keep out of loops
Application.EnableEvents = False
If Target.Value < Target.Offset(0, 1).Value * 2 Then
Target.Offset(0, 1).ClearContents
Target.Offset(0, 1).Select
MsgBox "Re-enter a valid value in " & Target.Offset(0, 1).Address(False, False)
Else
Target.Offset(0, 1).ClearContents
Target.Offset(0, 1).Select
End If
Application.EnableEvents = True
End Sub
Bookmarks