Adding checkbox on a row when data is entered in first column of that row

P

Paul

I am using the following code to add a checkbox in column G of a
certain row every time a user enters data in that row. Somehow the
actual checkbox appears four cells above the actual cell and I cannot
seem to figure out why.
Any help would be appreciated!

Thanks,
Paul

PS Sorry I also posted this in the wrong group.


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 Then
If IsEmpty(Target) Then Exit Sub
Set rng = Cells(Target.Row, "G")
' Check if there is already a checkbox
For Each obj In ActiveSheet.OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
If obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next

With ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
.Object.Caption = ""
.LinkedCell = rng.Address
.Object.Value = False
End With
Application.ScreenUpdating = True

End If
End Sub
 
D

Dave Peterson

I bet you're zoom factor isn't set to 100%.

And if you change it to 100%, it works ok.

A long time ago, there was another post like this. I fiddled by adjusting the
position in a loop. Just subtracting a little bit and seeing if it was ok. If
not, adjust a little more. (it worked, but looked pretty ugly.)

Tom Ogilvy just set the position twice and it worked fine!

So I changed the zoom factor to 25% and ran your code--your checkboxes were off
by a couple of rows.

But when I ran this version, it seemed to work ok.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rng As Range
Dim obj As OLEObject

Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 Then
If IsEmpty(Target) Then Exit Sub
Set rng = Cells(Target.Row, "G")
' Check if there is already a checkbox
For Each obj In ActiveSheet.OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
If obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next

Set obj = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
With obj
.Object.Caption = ""
.LinkedCell = rng.Address
.Object.Value = False
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
End With
Application.ScreenUpdating = True

End If
End Sub

Sometimes you have to treat those checkboxes as puppy dogs. Sit! Stay! <vbg>.
 
P

Paul

W@W! Thank you so very very much, Dave! Your code worked like a
charm!!!
I am getting more and more amazed by all the possibilities in Excel. I
am just starting to learn all this programming in Excel so I might be
asking some easy questions here:

1. How can I change the background color for these checkboxes from
standard white to black in the code you gave me?

2. Can I simultaneously (so when a user types something in the first
column) add in column H a dropdown menu with three choices (text1,
text2 or text3) that are linked with the values 1, 2 and 3 (or
"text1", "text2" and "text3" as long as something is in the cell when
you click on it) in the cell of the dropdown menu? These should have a
standard value of text2. I don't know if this is possible at all, but
if it could be added to the code you already gave me that would be
fantastic.

Thank you so so so very very very much!!!
Paul
 
P

Paul

Also, is there any way to manually delete one of these checkboxes if
they appear when you don't really want them to appear?
Thanks,
Paul
 
D

Dave Peterson

#1. You can't change the box itself, but you can change the background of the
"caption" area.

Play around with changing the color of a test checkbox (properties|backcolor).

I used this and it worked for me (just the portion that changed):

With obj
.Object.Caption = ""
.LinkedCell = rng.Address
.Object.Value = False
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
.Object.BackColor = &H80000017
.Name = "CBX_" & .TopLeftCell.Address(0, 0)
End With

And I named the checkbox after the cell it was in:
cbx_G89 (for example)

then all I have to do is this:

on error resume next
me.oleobjects("cbx_" & me.cells(target.row,"G").address(0,0)).delete
on error goto 0

oops. you wrote manually in the second post. Go into design mode, select it
and delete it (and exit design mode).

This doesn't delete any comboboxes already there (but you've done that with
checkboxes, so you can do that with comboboxes!):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rng As Range
Dim obj As OLEObject

Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 Then
If IsEmpty(Target) Then Exit Sub
Set rng = Me.Cells(Target.Row, "G")
' Check if there is already a checkbox
For Each obj In ActiveSheet.OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
If obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next

Set obj = Me.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
With obj
.Object.Caption = ""
.LinkedCell = rng.Address
.Object.Value = False
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
.Object.BackColor = &H80000017
.Name = "CBX_" & .TopLeftCell.Address(0, 0)
End With

Set rng = Me.Cells(Target.Row, "H")
Set obj = Me.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
'
With obj
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
.Object.AddItem "text1"
.Object.AddItem "text2"
.Object.AddItem "text3"
If IsNumeric(Target.Value) Then
If CLng(Target.Value) < .Object.ListCount _
And CLng(Target.Value) > 0 Then
.Object.Value = .Object.List(CLng(Target.Value) - 1)
End If
End If
End With
Application.ScreenUpdating = True

End If
End Sub
 
P

Paul

Amazing!!! This works like a charm as well. Thank you so much once
again.
Could you tell me how (in de code) you can adjust the combobox so that
users cannot edit its contents but can still choose one of three
options?
Paul
 
D

Dave Peterson

Go into design mode again.
Click on the Properties icon on that control toolbox toolbar
select a combobox
look for Style
You'll see a couple of options.
fmStyleDropDownCombo
and
fmStyleDropDownList

The "fmStyleDropDownCombo" allows users to type anything into the combobox.
the "fmStyleDropDownList" allows typing--but it has to match.

So you can add one line in your code (at the bottom):

'.....

With obj
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
.Object.AddItem "text1"
.Object.AddItem "text2"
.Object.AddItem "text3"
.Object.Style = fmStyleDropDownList '<-----
If IsNumeric(Target.Value) Then
If CLng(Target.Value) < .Object.ListCount _
And CLng(Target.Value) > 0 Then
.Object.Value = .Object.List(CLng(Target.Value) - 1)
End If
End If
End With
Application.ScreenUpdating = True

End If
End Sub
 
P

Paul

Thank you so much Dave!
There's one thing that your code did not solve: if you use this code
and a new line is added, after closing the workbook and opening it
again you are not able to change the combobox anymore. This is a
little strange, maybe a bug in Excel or did I do something wrong?
 
P

Paul

It's just too bad that if you sort the rows that already have
checkboxes, they come back a few rows too high (even with the zoom to
100%). The values are still linked to the correct cells but you do see
the wrong thing.
I don't suppose there is anything we can do about that, right? Just in
case you have another trick in your magic hat, here is the code I use
to sort:

Range("A17:AZ2005").Select
Selection.Sort Key1:=Range("A17"), Order1:=xlAscending,
Key2:=Range("M17" _
), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2 _
:=xlSortNormal
ActiveCell.End(xlDown).Offset(1, 0).Select

In case there is nothing to do about that, we will just have to do
without sorting. No really big deal, you just want to get it
perfect...

Thanks for all your help!!!
 
D

Dave Peterson

When I sorted my worksheet, both the comboboxes and checkboxes moved with the
cells.

If you rightclick on one of the checkboxes/comboboxes, and choose format object,
do you see "move and size with cells" or "move but don't size with cells"
checked.

But I was at 100% when I added them and when I sorted.

You can change this in code with something like:

With obj
.Placement = xlMoveAndSize
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
....

but I think you have a bigger problem. The linked cells are gonna get screwed
up (well, they did for me).

If you get the objects to move correctly, you could always loop through the
checkboxes and reassign the linked cell.
 
P

Paul

Thanks to your help, I got it almost worked out. I adjusted the code
slightly from the one that I showed you before, but basically it is
the same.

The problem I keep having is that when I save and exit the workbook
and then open it again, the values (text1, text2, etc) in the
comboboxes are at the value I entered before exiting and I cannot
adjust that anymore. I can edit the checkboxes though.

I am now using the following code and it seems to work fine, even with
sorting and zoom factor not at 100%:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rng As Range
Dim obj As OLEObject

Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub
If Target.Row < 17 Then Exit Sub
If Target.Column = 7 Then
Cells(Target.Row, "C").Select
If IsEmpty(Target) Then Exit Sub

Target.Offset(, -6) = Date
Target.Offset(, -5).Font.Size = "12"
Target.Offset(, -5).Interior.Color = RGB(204, 204, 255)
Target.Offset(, -4).Interior.Color = RGB(204, 204, 255)
Target.Offset(, -4).Font.Size = "11"

Set rng = Cells(Target.Row + 1, "F")
' Check if there is already a checkbox
For Each obj In ActiveSheet.OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
If obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next


Set obj = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
With obj
.Object.Caption = ""
.LinkedCell = rng.Address
.Placement = xlMoveAndSize
.Object.BackColor = RGB(204, 204, 255)
.Object.Value = True
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
End With

Set rng = Me.Cells(Target.Row + 1, "E")
' Check if there is already a combobox
For Each obj In ActiveSheet.OLEObjects
If TypeOf obj.Object Is MSForms.ComboBox Then
If obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next

Set obj = Me.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
'
With obj
.LinkedCell = rng.Address
.Placement = xlMoveAndSize
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
.Object.AddItem "text1"
.Object.AddItem "text2"
.Object.AddItem "text3"
.Object.Style = fmStyleDropDownList
.Object.Value = "text2"

End With


Set rng = Cells(Target.Row + 1, "H")
' Check if there is already a checkbox
For Each obj In ActiveSheet.OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
If obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next


Set obj = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
With obj
.Object.Caption = ""
.LinkedCell = rng.Address
.Placement = xlMoveAndSize
.Object.Value = False
.Object.BackColor = RGB(255, 204, 153)
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
End With

Set rng = Cells(Target.Row + 1, "J")
' Check if there is already a checkbox
For Each obj In ActiveSheet.OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
If obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next


Set obj = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
With obj
.Object.Caption = ""
.LinkedCell = rng.Address
.Placement = xlMoveAndSize
.Object.Value = False
.Object.BackColor = RGB(204, 204, 255)
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
End With

Cells(Target.Row, "I").Select
Application.ScreenUpdating = True

End If
End Sub
 
D

Dave Peterson

Well, that's no good.

You could .additem when you open the workbook (or activate the sheet).

Or you could just set up the .listfillrange to point at another worksheet
(hidden???).

I used Sheet2, A1:A3 for my testing.


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rng As Range
Dim Obj As OLEObject
Dim myListRng As Range


Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub
If Target.Row < 17 Then Exit Sub
If Target.Column = 7 Then
Cells(Target.Row, "C").Select
If IsEmpty(Target) Then Exit Sub

With Me.Parent.Worksheets("sheet2")
Set myListRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With


Target.Offset(, -6) = Date
Target.Offset(, -5).Font.Size = "12"
Target.Offset(, -5).Interior.Color = RGB(204, 204, 255)
Target.Offset(, -4).Interior.Color = RGB(204, 204, 255)
Target.Offset(, -4).Font.Size = "11"

Set rng = Cells(Target.Row + 1, "F")
' Check if there is already a checkbox
For Each Obj In ActiveSheet.OLEObjects
If TypeOf Obj.Object Is MSForms.CheckBox Then
If Obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next


Set Obj = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
With Obj
.Object.Caption = ""
.LinkedCell = rng.Address
.Placement = xlMoveAndSize
.Object.BackColor = RGB(204, 204, 255)
.Object.Value = True
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
End With

Set rng = Me.Cells(Target.Row + 1, "E")
' Check if there is already a combobox
For Each Obj In ActiveSheet.OLEObjects
If TypeOf Obj.Object Is MSForms.ComboBox Then
If Obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next

Set Obj = Me.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)

With Obj
.LinkedCell = rng.Address
.Placement = xlMoveAndSize
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
.ListFillRange = myListRng.Address(external:=True)

.Object.Style = fmStyleDropDownList
.Object.Value = myListRng(2).Value

End With


Set rng = Cells(Target.Row + 1, "H")
' Check if there is already a checkbox
For Each Obj In ActiveSheet.OLEObjects
If TypeOf Obj.Object Is MSForms.CheckBox Then
If Obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next


Set Obj = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
With Obj
.Object.Caption = ""
.LinkedCell = rng.Address
.Placement = xlMoveAndSize
.Object.Value = False
.Object.BackColor = RGB(255, 204, 153)
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
End With

Set rng = Cells(Target.Row + 1, "J")
' Check if there is already a checkbox
For Each Obj In ActiveSheet.OLEObjects
If TypeOf Obj.Object Is MSForms.CheckBox Then
If Obj.TopLeftCell.Address = rng.Address Then
Exit Sub
End If
End If
Next


Set Obj = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=rng.Left, _
Top:=rng.Top, _
Width:=rng.Width, _
Height:=rng.Height)
With Obj
.Object.Caption = ""
.LinkedCell = rng.Address
.Placement = xlMoveAndSize
.Object.Value = False
.Object.BackColor = RGB(204, 204, 255)
.Left = rng.Left
.Top = rng.Top
.Width = rng.Width
.Height = rng.Height
End With

Cells(Target.Row, "I").Select
Application.ScreenUpdating = True

End If
End Sub


Thanks to your help, I got it almost worked out. I adjusted the code
slightly from the one that I showed you before, but basically it is
the same.

The problem I keep having is that when I save and exit the workbook
and then open it again, the values (text1, text2, etc) in the
comboboxes are at the value I entered before exiting and I cannot
adjust that anymore. I can edit the checkboxes though.

I am now using the following code and it seems to work fine, even with
sorting and zoom factor not at 100%:
Click to expand...
<<snipped>>
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Putting 2 command buttons into 1 cell 2
Adding a checkbox in a row every time a user enters data in the first column of that row 5
Checkboxes disappear after macro is run 7
Removing border around Check box 0
Date Stamp in Last Column in active row if any data changes in row 1
Checkbox limitations 3
Delete an OLE Check Box in COde when a deleting a row 5
Help: weild checkbox problem 0

Top