PDA

View Full Version : [SOLVED] Range " does not contain" - code



Pawel
07-22-2016, 06:04 AM
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
07-22-2016, 06:41 AM
Get the TopLeftCell property of each shape and check if it intersects your range

Pawel
07-22-2016, 07:37 AM
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
07-22-2016, 08:08 AM
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 Subor:

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
07-22-2016, 09:09 AM
Yup that works perfect , Thanks p45cal.
btw. cool idea with "somethingfound" :)

Pawel
07-22-2016, 10:06 AM
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
07-22-2016, 10:23 AM
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
07-22-2016, 10:35 AM
Thanks again p45cal, now everything is OK :)

p45cal
07-22-2016, 11:31 AM
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
07-22-2016, 03:51 PM
Already did that :)

Pawel
07-25-2016, 07:47 AM
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
07-25-2016, 10:16 AM
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
07-25-2016, 10:27 AM
Works perfect now.
Thank you once again p45cal :)