Solved: excel help - adding checkboxes to sheet

[trippo]

I have a code that places checkboxes in 60 consecutive cells of a column. As the checkboxes are placed, the first checkbox is aligned in the cell, but as the others are placed down the column, the checkboxes start to wander out of the cell such that the last checkbox is no longer in the last cell location (somewhat below).

I have tried to use the activecell .top and .left commands, but that doesn't work (even if I select the last cell location, it will place the checkbox below the row). I have tried to calculate the position in inches based on the number of rows and their heights and that doesn't work (it's almost like the row heights are not as large as indicated).

Thoughts?


'Make sure all rows and columns are the correct height and width as the check boxes are added based upon the cell height and width.
Header1 = 15.75
Header2 = 24#
HeightRow = 18#
Column1 = 35#
Column2 = 7.5
Column3 = 11#
Column4 = 12#
WidthColumn = 16#

Range("A1:A1").EntireRow.RowHeight = Header1
Range("A2:A2").EntireRow.RowHeight = Header2
Range("A3:A3").EntireRow.RowHeight = Header1
Range("A4:A4").EntireRow.RowHeight = Header1
Range("A5:A" & FinalRow).EntireRow.RowHeight = HeightRow


Columns(1).ColumnWidth = Column1
Columns(2).ColumnWidth = Column2
Columns(3).ColumnWidth = Column3
Columns(4).ColumnWidth = Column4
DataColumn = 5
Do Until DataColumn = FinalColumn
Columns(DataColumn).ColumnWidth = WidthColumn
DataColumn = DataColumn + 1
Loop

'Insert a column to the left of the selected/input column
Range(InputColumnInsert & "1", InputColumnInsert & "1").EntireColumn.Insert

'Start inserting checkboxes after the heading rows.This assumes the first checkbox row is in row number 5.
ChkBxLocation = "71.25"
For RowNum = 5 To FinalRow
'Select the first cell of the range to insert the check box.
Range(InputColumnInsert & RowNum).Select


Edit: VBA tags added to code.

[lucas]

You can format your code for the forum by selecting it when posting and hitting the vba button.

On your question, can I suggest an alternative that doesn't require creating controls. See attached.

[trippo]

Yeah, I have seen that technique online, but as I already had many checkboxes in place, I was hoping to solve the wandering control box problem.

[trippo]

I made the change to something similar to your suggestion...it was spot on. A lot easier to work with and I was able to write a routine to replace all my checkboxes as appropriate.

thanks,
trippo :content:

[lucas]

You might post your solution if you feel like sharing it.

Please mark your thread solved using the thread tools at the top of the page. That way others looking to help won't read the entire thread just to find it's been solved.

[trippo]

Here is the code I used to find all the checkboxes I had inserted and any checkbox that was checked, I replaced with an "a". (first I had to find the checkbox and then read the linkedcell information...)

Sub DeleteAllCheckboxes()
Dim ChkBx As String
Dim InputColumnDelete As String
Dim ConfirmDelete As String
Sheets("Comparisons").Select

'Before continuing with the deletion, confirm with user as the column cannot be restored (undone).
ConfirmDelete = "You have chosen to delete all check boxes: " & InputColumnDelete & ". This cannot be undone once complete. Do you want to continue?"
DeleteResponse = MsgBox(ConfirmDelete, vbInformation + vbYesNo, "Delete Column")
If DeleteResponse = 7 Then
Exit Sub
End If
'Determine the size of the range. Assumes max columns times max rows will be greater than check box number
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
FinalColumn = Cells(5, 256).End(xlToLeft).Column
CheckBxLimit = FinalRow * FinalColumn * 2
'Search for text boxes to be deleted. These have to be deleted seperately.
'If the text box number does not exist, an error is returned and the next check box is found.
ChkBx = "Check Box "
CheckBoxNum = 1
SkipToNext = False
cellnum = 1
Do Until cellnum = CheckBxLimit
'If check box is not found, jump to error handler
On Error GoTo FindNextChkBx

ActiveSheet.Shapes(ChkBx & CheckBoxNum).Select
'CheckBoxNum = CheckBoxNum + 1
On Error GoTo 0
'If an error was found, then SkipToNext would be true and this does not run until a check bos is found
If SkipToNext = False Then
'Grab the cell link from the check box
ShapeCellLink = Selection.LinkedCell
If ShapeCellLink = "#REF!" Then
ActiveSheet.Shapes(ChkBx & CheckBoxNum).Select
Selection.Cut
Range(ShapeCellLink).ClearContents
Else
Range(ShapeCellLink).Select
'Determine what column the check box is linked to
ShapeColumn = ActiveCell.Column

'if the check box is linked to the user input column to delete, then delete that check box and clear the cell
ActiveSheet.Shapes(ChkBx & CheckBoxNum).Select
Selection.Cut
If Range(ShapeCellLink) = True Then
Range(ShapeCellLink) = "a"
Else
Range(ShapeCellLink) = ""
End If

End If
End If

'Increment to find the next check box number.
cellnum = cellnum + 1
CheckBoxNum = CheckBoxNum + 1
SkipToNext = False

Loop

Exit Sub
'This is the error handler if a check box is selected that does not exist.
'Set the flag true to move ot the next check box value.
FindNextChkBx:
SkipToNext = True
Resume Next
End Sub


Then I used the following code on my sheet where I had replaced the checkboxes to run the macro on a doubleclick. The result is that the clicked cell would either display the checkmark (i.e. "a" in Marlett font) or be null and not display anything. I had over 1600 checkboxes on the page, so this vastly improves the previous eye strain!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim CheckmarkCells As Range
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
FinalColumn = Cells(2, 256).End(xlToLeft).Column
If FinalColumn < 26 Then
AlphaColumn = Chr(64 + FinalColumn)
Else
AlphaColumn = Chr(Int(FinalColumn / 26) + 64) & Chr((FinalColumn Mod 26) + 64)
End If
Set CheckmarkCells = Range("E5:" & AlphaColumn & FinalRow)
If Not Intersect(Target, CheckmarkCells) Is Nothing Then
If Target.Value = "a" Then
Target.ClearContents
Else
Target.Value = "a"
Target.Font.Name = "Marlett"
Target.Font.Size = "20"
End If
Target.Offset(0, 1).Select
End If
End Sub

[lucas]

Glad you got a good solution for your problem.

Could you edit your thread and add the vba tags to your code?