un-checked boxes

[icestationzbra]

hi,

i need some help with this code.

i am trying to check if certain cells in the sheet contain values (the
should not be blank). if any of them do not contain values, i was
checkbox to be placed along that row in a certain column and it shoul
be checked.

my code places a checkbox but does not check it on.

the code i am using is provided below. please debug it for me.

also, is there is a way to turn all the filters to "(All)" at once?
have a sheet where in there is a filter for every column. as soon a
the sheet is activated, i would like for all the columns to be filtere
to "(All)" irrespective of the criterion it had been filtered fo
earlier.

thanks in advance for the help.

mac.

*****

Sub FillCheckBoxes()

Dim rngCells As Range
Dim m As Integer
Dim n As Integer

Sheet2.Select
Range("a1").Activate
ActiveCell.CurrentRegion.Select
n = Selection.Rows.Count

For Each rngCells In Range("Q2:Q" & n)

With rngCells

With Sheet2.CheckBoxes.Add(.Left, .Top, 50, 20)

If ((Sheet2.Range("a" & n).Value = "") _
Or (Sheet2.Range("b" & n).Value = "") _
Or (Sheet2.Range("c" & n).Value = "") _
Or (Sheet2.Range("e" & n).Value = "") _
Or (Sheet2.Range("f" & n).Value = "") _
Or (Sheet2.Range("i" & n).Value = "") _
Or (Sheet2.Range("k" & n).Value = "") _
Or (Sheet2.Range("l" & n).Value = "") _
Or (Sheet2.Range("m" & n).Value = "")) Then

.Value = xlOn

Else

.Value = xlOff

End If

.LinkedCell = rngCells.Address
.Display3DShading = False

End With

End With

Next rngCells

End Su

 

[Tom Ogilvy]

value = xlOn

value = xlOff

should have a period in front

.Value = xlOn
.Value = xlOff

Use Showalldata to show all the data in a filter

On Error Resume Next
Activesheet.ShowAllData
On Error goto 0

 

[Dave Peterson]

Watch out for your "with" stuff.

..value = xlon/onoff
and
linkedcell and display3dshading, too.

And you don't usually have to select something to work with it.

Option Explicit
Sub FillCheckBoxes()

Dim rngCells As Range
Dim TotalRows As Long
Dim curRow As Long

With Sheet2
.CheckBoxes.Delete 'nice for testing???

TotalRows = .Range("a1").CurrentRegion.Rows.Count - 1
For Each rngCells In .Range("Q2:Q" & TotalRows)
With rngCells
curRow = .Row
With .Parent.CheckBoxes.Add(.Left, .Top, 50, 20)
If ((.Parent.Range("a" & curRow).Value = "") _
Or (.Parent.Range("b" & curRow).Value = "") _
Or (.Parent.Range("c" & curRow).Value = "") _
Or (.Parent.Range("e" & curRow).Value = "") _
Or (.Parent.Range("f" & curRow).Value = "") _
Or (.Parent.Range("i" & curRow).Value = "") _
Or (.Parent.Range("k" & curRow).Value = "") _
Or (.Parent.Range("l" & curRow).Value = "") _
Or (.Parent.Range("m" & curRow).Value = "")) Then
.Value = xlOn
Else
.Value = xlOff
End If
.LinkedCell = rngCells.Address(external:=True)
.Display3DShading = False
.Caption = ""
End With
.NumberFormat = ";;;"
End With

Next rngCells
End With

End Sub

I added the .caption bit and the .numberformat (so it looks like a plain
checkbox) and you can't see the true/false in the cell.

And
If .FilterMode Then
.ShowAllData
End If

is one way to show all the data.

 

[icestationzbra]

hi dave,

dave to the rescue again... i was almost wishing that you took a look
at the code .

while i was dabbling with the checkboxes code, i tweaked it a little
bit for the delete part. my code would not run correctly and it would
place these horrendous checkboxes along 1000 rows . so i used the
lil delete thingy to get rid of them. you are almost clairvoyant in
thinking it up.

i will run the code and come back here with my feedback.

thanks dave, appreciate the help.

mac.

 

[Peo Sjoblom]

If you are in the US you must have seen some of the commercials for
clairvoyants,
although he is disguised with a fez and a large moustache is Dave..

 

[Dave Peterson]

I _knew_ you were going to say that!

If you are in the US you must have seen some of the commercials for
clairvoyants,
although he is disguised with a fez and a large moustache is Dave..

--

Regards,

Peo Sjoblom

<<snipped>>

 

[icestationzbra]

peo,

i walked past a distinguished looking gentleman in pince-nez with a
glass ball, all glittering with xl macros! could he have been the one?
...

dave,

it worked fine.

if i could ask just one more question.

if the said columns are blank, is there a way to prevent the checkbox
from being unchecked until the columns are entered with data?

thanks,

mac.

 

[Dave Peterson]

You could add a line to the original code that assigns a macro to each checkbox.

'''''''''''''''''''existing code'''''
.LinkedCell = rngCells.Address(external:=True)
.Display3DShading = False
.Caption = ""
.OnAction = ThisWorkbook.Name & "!checkCells"
''''''''''''''''''more existing code'''''


and the macro that does the work:


Sub checkCells()

Dim myCBX As CheckBox
Dim curRow As Long

With ActiveSheet
Set myCBX = .CheckBoxes(Application.Caller)

curRow = myCBX.TopLeftCell.Row

If .Cells(curRow, "A").Value = "" _
And .Cells(curRow, "B").Value = "" _
And .Cells(curRow, "C").Value = "" _
And .Cells(curRow, "E").Value = "" _
And .Cells(curRow, "F").Value = "" _
And .Cells(curRow, "I").Value = "" _
And .Cells(curRow, "K").Value = "" _
And .Cells(curRow, "L").Value = "" _
And .Cells(curRow, "M").Value = "" Then
myCBX.Value = xlOn
Else
'do nothing
End If
End With
End Sub

(And I wasn't completely sure if you wanted ANDs or ORs in this portion.)

But it really looks like you're just using it as an indicator. Maybe you could
have the user stop checking the box and have some code that does it for you.

=========

This is modified slightly:

.LinkedCell = rngCells.Address(external:=True)
.Display3DShading = False
.Caption = ""
'''not necessary''' .OnAction = ThisWorkbook.Name & "!checkCells"
.Name = "CBX_" & .TopLeftCell.Address(0, 0)

And in the worksheet_change event behind sheet2:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRng As Range
Dim curRow As Long
Dim myRngToCheck As Range

Set myRng = Me.Range("a:c,e:f,i:i,k:m")

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, myRng) Is Nothing Then Exit Sub

curRow = Target.Row

Set myRngToCheck = Intersect(myRng, Me.Rows(curRow))

If Application.CountA(myRngToCheck) = myRngToCheck.Cells.Count Then
Me.CheckBoxes("cbx_Q" & curRow).Value = xlOn
Else
Me.CheckBoxes("cbx_Q" & curRow).Value = xlOff
End If

End Sub


=======
In fact, if I were doing it, I think I'd just a worksheet formula and a nice
message:

"all done" or "keep going"

<vbg>

 

[icestationzbra]

hi,

i have a couple of issues that i am facing with respect to th
checkboxes.

the checkboxes appear at the left-top of a cell. there are severa
hundred rows and it is getting to be really hard to get them to th
center-center of the cell. i was not able to figure out how i coul
align them using a VB command.

also, i am trying to count the number of checked boxes if a certai
condition is satisfied. an excerpt of the code is given below.

For m = 1 To TotalRows

If (Left((.Range("A" & m)), 2) = "AB") Then

If (CheckBoxes(.Range("D" & m)).Checked = True) Then

i = i + 1

...

i am not getting the Checked=True part right, rather, i do not know th
syntax for excel. i know that in VB, i am to use 'vbchecked' o
'unchecked'. that is not working here. i am not able to find it in th
excel help.

please help me.

thanks,

mac

 

[Dave Peterson]

I think the easiest thing to do is to have the checkboxes fill the cells
completely:

Change the line that adds the checkboxes to something like:

With .Parent.CheckBoxes.Add _
(Left:=.Left, _
Top:=.Top, _
Height:=.Height, _
Width:=.Width)

(The .left,.top,.height,.width still refer to the rngCells.)

But you could center them with something like:

Option Explicit
Sub FillCheckBoxes()

Dim rngCells As Range
Dim TotalRows As Long
Dim curRow As Long

Dim myTop As Double
Dim myHeight As Double
Dim myLeft As Double
Dim myWidth As Double

With Sheet2
.CheckBoxes.Delete 'nice for testing???

TotalRows = .Range("a1").CurrentRegion.Rows.Count - 1
For Each rngCells In .Range("Q2:Q" & TotalRows)
With rngCells
curRow = .Row

myWidth = .Width / 3
myTop = .Top
myHeight = .Height / 3
myLeft = .Left

With .Parent.CheckBoxes.Add _
(Left:=.Left + myWidth, _
Top:=.Top + myHeight, _
Height:=myHeight, _
Width:=myWidth)

If ((.Parent.Range("a" & curRow).Value = "") _
Or (.Parent.Range("b" & curRow).Value = "") _
Or (.Parent.Range("c" & curRow).Value = "") _
Or (.Parent.Range("e" & curRow).Value = "") _
Or (.Parent.Range("f" & curRow).Value = "") _
Or (.Parent.Range("i" & curRow).Value = "") _
Or (.Parent.Range("k" & curRow).Value = "") _
Or (.Parent.Range("l" & curRow).Value = "") _
Or (.Parent.Range("m" & curRow).Value = "")) Then
.Value = xlOn
Else
.Value = xlOff
End If
.LinkedCell = rngCells.Address(external:=True)
.Display3DShading = False
.Caption = ""
End With
.NumberFormat = ";;;"
End With

Next rngCells
End With

End Sub


I took the middle third of the cell to spot the checkbox. You can play around
(25% top/bottom and 50% checkbox) with whatever ratio you want. But try it a
little. It looked nice with large rowheights, but it overflowed if I made the
rows too narrow.


And since you're actually using a linked cell, you could just use =countif() to
grab the number of trues.

Sub showme()

Dim myRng As Range

With Sheet2
Set myRng = .Range("q2", .Cells(.Rows.Count, "Q").End(xlUp))
MsgBox Application.CountIf(myRng, True)
MsgBox Application.Evaluate("SumProduct(" _
& "--(" & myRng.Offset(0, -1).Address(external:=True) _
& " =""AB"")," _
& "--(" & myRng.Address(external:=True) & "=True))")
End With
End Sub


But if you wanted to loop through them, you could name them when you put them on
the worksheet:

.LinkedCell = rngCells.Address(external:=True)
.Display3DShading = False
.Caption = ""
.Name = "CBX_" & .TopLeftCell.Address(0, 0)

Now each checkbox has a name like: CBX_Q13 (when it's in row 13).

Sub showme2()

Dim myRng As Range
Dim myCell As Range
Dim CountOfChecked As Long

CountOfChecked = 0
With Sheet2
Set myRng = .Range("p2", .Cells(.Rows.Count, "p").End(xlUp))
For Each myCell In myRng.Cells
If UCase(myCell.Value) = "AB" Then
If .CheckBoxes("CBX_Q" & myCell.Row).Value = xlOn Then
CountOfChecked = CountOfChecked + 1
End If
End If
Next myCell
End With

MsgBox CountOfChecked

End Sub

 

[icestationzbra]

hi dave,

i used the code provided by you. after extensive research, i came up
with the following parameters for getting the checkboxes almost in the
centre of the cell.

x = 2.5
y = 60

myWidth = .Width / x
myTop = .Top
myHeight = .Height
myLeft = .Left

With .Parent.CheckBoxes.Add _
(Left:=.Left + myWidth, _
Top:=.Top + (.Height / y), _
Height:=myHeight, _
Width:=myWidth)

thank you very much for helping out with this issue.

regards,

mac.

 

[icestationzbra]

hi,

i am using the code for creating checkboxes in conjunction with another
piece which row-autofits merged cells correctly.

i am having an issue.

the checkboxes that the macro created, they all have very large
envelope area (that grainy area around the checkbox wherein the caption
appears). when the row is autofit, some of the checkboxes' envelope
intrude into adjacent cells. these intruding checkboxes get clicked
when adjacent cells are clicked on.

i hope i was able to provide a clear picture of the issue.

i looked thru the code that i am using, and i was not able to find
anything that i could tweak.

please help. code is posted below.

mac.

*****
Option Explicit
Dim n As Integer
Dim rngCell As Range
Dim r As Integer

Sub AutofitRowHeight()

Dim intFinRowH As Integer
Dim intCurRowH As Integer

With Sheet1

n = InputBox("Last Row", "Row")

For Each rngCell In .Range("b14:b" & n)

intCurRowH = (rngCell.RowHeight) * 1.25

If ActiveCell.MergeCells Then

rngCell.UnMerge

End If

r = rngCell.Row

Range("b" & r & ":c" & r).Select

Selection.Locked = False
Selection.FormulaHidden = False
Selection.Font.Name = "Verdana"
Selection.Font.Size = "9"

Selection.Merge

rngCell.MergeArea.Merge

If (.Range("b" & r) <> "") Then

With rngCell.MergeArea

..UnMerge
..EntireRow.AutoFit

..HorizontalAlignment = xlCenterAcrossSelection
..VerticalAlignment = xlCenter
..WrapText = True
..Orientation = 0
..AddIndent = False
..IndentLevel = 0
..ShrinkToFit = False
..ReadingOrder = xlContext
..MergeCells = False
intFinRowH = (.RowHeight) * 1.1

..Merge
..RowHeight = IIf(intCurRowH > intFinRowH, intCurRowH,
intFinRowH)
..HorizontalAlignment = xlLeft

End With

Selection.Locked = True
Selection.FormulaHidden = True
Selection.Font.Name = "Verdana"
Selection.Font.Size = "9"

Else

rngCell.UnMerge

End If

Next rngCell

End With

Call FillCheckBoxes(n)

End Sub

Sub FillCheckBoxes(n)

Dim curRow As Long

Dim m As Integer

Dim x As Variant
Dim y As Variant
Dim z As Variant

Dim myTop As Double
Dim myHeight As Double
Dim myLeft As Double
Dim myWidth As Double

m = 14
x = 2.5
y = 10

With Sheet1

..CheckBoxes.Delete

For Each rngCell In .Range("D" & m & "" & n)

r = rngCell.Row

If (.Range("b" & r) <> "") Then

With rngCell

..ClearContents
curRow = .Row

myWidth = .Width / x
myTop = .Top
myHeight = .Height
myLeft = .Left

With .Parent.CheckBoxes.Add _
(Left:=.Left + myWidth, _
Top:=.Top + (.Height / y), _
Height:=myHeight, _
Width:=myWidth)
..Value = xlOff
..LinkedCell = rngCell.Address(external:=False)
..Display3DShading = False
..Caption = ""
..Placement = xlMove
..PrintObject = True
End With

..NumberFormat = ";;;"

End With

Else

With rngCell

..ClearContents
..NumberFormat = "0"

End With

End If

Next rngCell

For Each rngCell In .Range("E" & m & ":E" & n)

r = rngCell.Row

If (.Range("b" & r) <> "") Then

With rngCell

..ClearContents
curRow = .Row

myWidth = .Width / x
myTop = .Top
myHeight = .Height
myLeft = .Left

With .Parent.CheckBoxes.Add _
(Left:=.Left + myWidth, _
Top:=.Top + (.Height / y), _
Height:=myHeight, _
Width:=myWidth)
..Value = xlOff
..LinkedCell = rngCell.Address(external:=False)
..Display3DShading = False
..Caption = ""
..Placement = xlMove
..PrintObject = True
End With

..NumberFormat = ";;;"

End With

Else

With rngCell

..ClearContents
..NumberFormat = "0"

End With

End If

Next rngCell

..CheckBoxes.Select

End With

End Sub
*****

 

[Dave Peterson]

After just a little testing, it looks to me like there's a limit to how much you
can shrink the checkbox from the Forms toolbar. I could use code to adjust the
..height and .top, but the checkbox shown on the cell didn't seem to be reduced
in size.

(Although when I right clicked on the checkbox, the outline looked smaller.)

You may want to look at the checkbox from the ControlToolbox toolbar. If you
right click on it and choose "Format Control" and look at the properties tab,
you'll see an option for "move and size with cells". It might be what you
really want.

And to make matters worse, the code used to add/manipulate them is different
from the Forms toobar version.

I didn't try to incorporate all you algorithm into this, but it may give you a
headstart on converting your code. (try it manually first to see if you really
want to change things.)

Option Explicit
Sub testme()
Call FillCheckBoxes(12)
End Sub
Sub FillCheckBoxes(n)

Dim m As Long
Dim r As Long
Dim rngCell As Range
Dim curRow As Long

Dim OLEObj As OLEObject

m = 5

With ActiveSheet

For Each OLEObj In .OLEObjects
If TypeOf OLEObj.Object Is MSForms.CheckBox Then
OLEObj.Delete
End If
Next OLEObj

For Each rngCell In .Range("D" & m & "" & n)
r = rngCell.Row
If (.Range("b" & r) <> "") Then
With rngCell
.ClearContents
.NumberFormat = ";;;"

Set OLEObj = .Parent.OLEObjects.Add _
(ClassType:="Forms.CheckBox.1", _
Link:=False, DisplayAsIcon:=False, _
Left:=.Left, Top:=.Top, _
Width:=.Width, Height:=.Height)

With OLEObj
.LinkedCell = rngCell.Address(external:=False)
.Placement = xlMoveAndSize
.PrintObject = True
With .Object
.Value = False
.Caption = ""
End With
End With

End With
End If
Next rngCell
End With

End Sub

======
And watchout for those dots. You had dropped a few in the code you posted.

Value = xlOff
LinkedCell = rngCell.Address(external:=False)
Display3DShading = False
Caption = ""
Placement = xlMove
PrintObject = True

(maybe it was the excelforum that dropped them???)

hi,

i am using the code for creating checkboxes in conjunction with another
piece which row-autofits merged cells correctly.

i am having an issue.

the checkboxes that the macro created, they all have very large
envelope area (that grainy area around the checkbox wherein the caption
appears). when the row is autofit, some of the checkboxes' envelope
intrude into adjacent cells. these intruding checkboxes get clicked
when adjacent cells are clicked on.

i hope i was able to provide a clear picture of the issue.

i looked thru the code that i am using, and i was not able to find
anything that i could tweak.

please help. code is posted below.

mac.

<<snipped>>