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

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.

Paul wrote:

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

--

Dave Peterson

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 he

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

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

#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

Paul wrote:

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 he

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

--

Dave Peterson

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

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


Paul wrote:

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

--

Dave Peterson

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?

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!!!

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.

Paul wrote:

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!!!

--

Dave Peterson

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