Range " does not contain" - code

[Pawel]

HI,
I'm trying to write a code for my macro and I can't figure out how to do this properly.
I would like to obtain sth like that:

If "selected cells area" "does not contain" "checkbox or option button" then...

Anyone help?

[mdmackillop]

Get the TopLeftCell property of each shape and check if it intersects your range

[Pawel]

This is what I have right now ( not working)

Dim RngOff As Range, Ob

For Each Ob In ActiveSheet.OptionButtons
             If Application.Intersect(Ob.TopLeftCell, RngOff) Is Nothing 
      Then 
             MsgBox ("***x")

Next ob

For Each Ob In ActiveSheet.OptionButtons
     If Application.Intersect(Ob.TopLeftCell, RngOff) Is Nothing 
     Then
     MsgBOX ("aaa")

[p45cal]

Either an adaptation of something I did for you elsewhere:

Sub check2()
Dim RngClrBut As Range
somethingfound = False
Set RngClrBut = Selection
For Each Ob In ActiveSheet.CheckBoxes
  If Not Application.Intersect(Ob.TopLeftCell, RngClrBut) Is Nothing Then
    somethingfound = True
    Exit For
  End If
Next Ob
If Not somethingfound Then
  For Each Ob In ActiveSheet.OptionButtons
    If Not Application.Intersect(Ob.TopLeftCell, RngClrBut) Is Nothing Then
      somethingfound = True
      Exit For
    End If
  Next Ob
End If
If Not somethingfound Then MsgBox "No optionbutton or check box in this selection"
End Sub

or:

Sub check3()
somethingfound = False
For Each shp In ActiveSheet.Shapes
  If shp.Type = msoFormControl Then
    If shp.FormControlType = xlOptionButton Or shp.FormControlType = xlCheckBox Then
      If Not Intersect(Selection, shp.TopLeftCell) Is Nothing Then
        somethingfound = True
        Exit For
      End If
    End If
  End If
Next shp
If Not somethingfound Then MsgBox "No optionbutton or check box in this selection"
End Sub

[Pawel]

Yup that works perfect , Thanks p45cal.
btw. cool idea with "somethingfound"

[Pawel]

I've made a combination of both codes you helped me with:

Sub check2()
    Dim RngClrBut As Range, ob
    somethingfound = False
    
    If Selection.Count > 0 Then
        Set RngClrBut = Selection.SpecialCells(xlVisible)
        For Each ob In ActiveSheet.CheckBoxes
            If Not Application.Intersect(ob.TopLeftCell, RngClrBut) Is Nothing Then
                ob.Value = False
                somethingfound = True
            End If
            Exit For
     End If
    Next ob
    If Not somethingfound Then
        For Each ob In ActiveSheet.OptionButtons
            If Not Application.Intersect(ob.TopLeftCell, RngClrBut) Is Nothing Then
                ob.Value = False
                somethingfound = True
                
                Exit For
            End If
        Next ob
    End If
    If Not somethingfound Then MsgBox "No optionbutton or check box in this selection"
End Sub

But something is wrong.... When there is a couple of checkboxes within the selected range it's either: only one of them gets unchecked or I get an error "End if without block if"
Help Please.

[p45cal]

try:

Sub check2()
Dim RngClrBut As Range, ob
somethingfound = False

If Selection.Count > 0 Then
  Set RngClrBut = Selection.SpecialCells(xlVisible)
  For Each ob In ActiveSheet.CheckBoxes
    If Not Application.Intersect(ob.TopLeftCell, RngClrBut) Is Nothing Then
      ob.Value = False
      somethingfound = True
    End If
  Next ob
End If
If Not somethingfound Then
  For Each ob In ActiveSheet.OptionButtons
    If Not Application.Intersect(ob.TopLeftCell, RngClrBut) Is Nothing Then
      ob.Value = False
      somethingfound = True
    End If
  Next ob
End If
If Not somethingfound Then MsgBox "No optionbutton or check box in this selection"
End Sub

[Pawel]

Thanks again p45cal, now everything is OK

[p45cal]

Actually, take out the red lines below too:
If Not somethingfound Then
For Each ob In ActiveSheet.OptionButtons
If Not Application.Intersect(ob.TopLeftCell, RngClrBut) Is Nothing Then
ob.Value = False
somethingfound = True
End If
Next ob
End If

[Pawel]

Already did that

[Pawel]

Actually there still is one issue...
Everything works just fine only if I select 2 cells or more.
If I select only one then it doesn't matter which cell is selected - macro unchecks all OptionButtons and checkboxes on the worksheet.

Current code is:

Private Sub CommandButton41_Click()
   Dim RngClrBut As Range, ob
    SomethingFound = False
     
    If Selection.Count > 0 Then
        Set RngClrBut = Selection.SpecialCells(xlVisible)
        For Each ob In ActiveSheet.CheckBoxes
            If Not Application.Intersect(ob.TopLeftCell, RngClrBut) Is Nothing Then
                ob.Value = False
                SomethingFound = True
            End If
        Next ob
    
        For Each ob In ActiveSheet.OptionButtons
            If Not Application.Intersect(ob.TopLeftCell, RngClrBut) Is Nothing Then
                ob.Value = False
                SomethingFound = True
            End If
        Next ob
    End If
    If Not SomethingFound Then MsgBox "No optionbutton or check box in this selection"
End Sub

Please help anyone.

[p45cal]

Ah yes, if there's only one cell selected then the .SpecialCells assumes you want to process the whole sheet!
Try:

Private Sub CommandButton41_Click()
Dim RngClrBut As Range, ob
SomethingFound = False

If Selection.Count > 0 Then
  If Selection.Count = 1 Then
    Set RngClrBut = Selection
  Else
    Set RngClrBut = Selection.SpecialCells(xlVisible)
  End If
  For Each ob In ActiveSheet.CheckBoxes
    If Not Application.Intersect(ob.TopLeftCell, RngClrBut) Is Nothing Then
      ob.Value = False
      SomethingFound = True
    End If
  Next ob

  For Each ob In ActiveSheet.OptionButtons
    If Not Application.Intersect(ob.TopLeftCell, RngClrBut) Is Nothing Then
      ob.Value = False
      SomethingFound = True
    End If
  Next ob
End If
If Not SomethingFound Then MsgBox "No optionbutton or check box in this selection"
End Sub

[Pawel]

Works perfect now.
Thank you once again p45cal