Add condition to my code

[hedcase10x]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C13:C150,D13:D150,H13:H150")) Is Nothing Then
Application.EnableEvents = False
If Target.Value = ChrW(&H2713) Then
Target.ClearContents
Cancel = True
Else
Target.Value = ChrW(&H2713)
Cancel = True
End If
End If
Application.EnableEvents = True
End Sub


i need to make the above code have a condition where column c fields will clear if column d adjacent field is not clear.....the above code puts a check mark in the field if i double click it....so if i double click c13...and d13 already has the check mark...double clicking c13 will clear d13 and so on

can anybody show me how to accomplish this ?

 

[ParamRay]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim rngCheckMarks As Range
  Dim strCheckMark As String
  
  On Error GoTo ErrorHandler
  Application.EnableEvents = False
  Set rngCheckMarks = Me.Range("C13:C150,D13:D150,H13:H150")
  strCheckMark = ChrW(&H2713)
  
  If Not Intersect(Target, rngCheckMarks) Is Nothing Then
    Cancel = True
    If CStr(Target.Value) = strCheckMark Then
      Target.ClearContents
    Else
      Intersect(Me.Rows(Target.Row), rngCheckMarks).ClearContents
      Target.Value = strCheckMark
    End If
  End If
  
ExitHandler:
  On Error Resume Next
  Application.EnableEvents = True
  Set rngCheckMarks = Nothing
  Exit Sub
  
ErrorHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub

 

[hedcase10x]

Almost....but I don't want the H13:H150 to be changed....only the C13:C150 and D13:D150

but thanks so far....

 

[ParamRay]

Almost....but I don't want the H13:H150 to be changed....only the C13:C150 and D13:D150

but thanks so far....

OK, try this instead:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim rngCheckMarks1 As Range
  Dim rngCheckMarks2 As Range
  Dim strCheckMark As String
  
  On Error GoTo ErrorHandler
  Application.EnableEvents = False
  Set rngCheckMarks1 = Me.Range("C13:D150")
  Set rngCheckMarks2 = Me.Range("H13:H150")
  strCheckMark = ChrW(&H2713)
  
  If Not Intersect(Target, rngCheckMarks1) Is Nothing Then
    Cancel = True
    If CStr(Target.Value) = strCheckMark Then
      Target.ClearContents
    Else
      Intersect(Me.Rows(Target.Row), rngCheckMarks1).ClearContents
      Target.Value = strCheckMark
    End If
  End If
  If Not Intersect(Target, rngCheckMarks2) Is Nothing Then
    Cancel = True
    If CStr(Target.Value) = strCheckMark Then
      Target.ClearContents
    Else
      Target.Value = strCheckMark
    End If
  End If
  
ExitHandler:
  On Error Resume Next
  Application.EnableEvents = True
  Set rngCheckMarks1 = Nothing
  Set rngCheckMarks2 = Nothing
  Exit Sub
  
ErrorHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub

 

[hedcase10x]

Wow...that's awesome...thanks much !