Cell Link assignment for check boxes

Hello Modytrane,

I revised this macro I wrote a back in March. This macro will automatically add a CheckBox to each cell you have selected. When it starts, you will be asked if you want to add a macro and a linked cell to the check boxes. The same macro will be run by each check box if you choose to add one. The link cell will update based on Excel's absolute and relative referencing for A1 style entries. You can link to another worksheet when prompted by including the sheet with the range, like this...
[code]
Sheet2!B10

'Written: March 17, 2009
'Updated: April 17, 2009 - Added Linked Cell with Relative or Absolute addressing
'Author:  Leith Ross
'Summary: Adds Form CheckBoxes to the selected cells and assign the macro "CheckBoxMacro"
'         to each CheckBox. CheckBoxes are sized automatically to fit the cell.

Private Sub AddCheckBoxToCell(Ref_cell As Range, ByVal Macro_Name As String, ByRef Link_Cell As Range)
    
  Dim ChkBox As CheckBox
  Dim N As Double
  Dim Wks As Worksheet
  
    With Ref_cell.Cells(1, 1)
      refLeft = .Left
      refTop = .Top
      refHeight = .Height
    End With
      
      Set Wks = Worksheets(Ref_cell.Parent.Name)
      Set ChkBox = Wks.CheckBoxes.Add(10, 10, 15, 12)
      
      N = (refHeight - ChkBox.Height) / 2#
      
    With ChkBox
      .Caption = Caption
      .Top = refTop + N
      .Left = refLeft
        If Not Link_Cell Is Nothing Then
           .LinkedCell = Link_Cell.Address
        Else
          .LinkedCell = ""
        End If
      .OnAction = Macro_Name
    End With
    
End Sub

Public Sub AddCheckBoxesToSelection()

  Dim AbsC As Boolean
  Dim AbsR As Boolean
  Dim Answer As String
  Dim C As Long
  Dim LinkCell As Range
  Dim MacroName As String
  Dim R As Long
  Dim RefCell As Range
           
    MacroName = InputBox("Do you want the Check Box to run a macro?" & vbCrLf _
              & "If so, enter the macro's name below.", "Add a Macro")
    
EnterLink:
    Answer = InputBox("Do you want to add a Linked Cell?" & vbCrLf _
           & "If so, enter the cell address below in A1 style." & vbCrLf _
           & "Relative and Absolute address rules apply.", _
           "Add a Link Cell")
           
    If Answer <> "" Then
       On Error GoTo BadRange
         Set LinkCell = Range(Answer)
       On Error GoTo 0
       AbsC = Answer Like "*[$][A-Za-z]*"
       AbsR = Answer Like "*[$][0-9]*"
    End If
    
      For Each RefCell In Selection
        On Error GoTo BadMacro
        AddCheckBoxToCell RefCell, MacroName, LinkCell.Offset(R, C)
        If (Not AbsC) Then
           C = C + 1
        End If
        If (Not AbsR) Then
           R = R + 1
        End If
        If C > Columns.Count Or R > Rows.Count Then GoTo NoMore
      Next RefCell
      
    Exit Sub
    
BadMacro:
    MsgBox "There is problem with the Macro to be assigned." & vbCrLf _
         & "Please correct the error and try again." & vbCrLf & vbCrLf _
         & "'" & MacroName & "' - " & Err.Description
    Exit Sub

BadRange:
    MsgBox "You have entered a Bad Range or Address." & vbCrLf _
         & "Please enter it again.", vbInformation
    Err.Clear
    On Error GoTo 0
    GoTo EnterLink
    
NoMore:
    MsgBox "Aborting - No more Check Boxes can be added to the Sheet.", vbCritical
    
End Sub

Adding the Macro
1. Copy the macro above pressing the keys CTRL+C
2. Open your workbook
3. Press the keys ALT+F11 to open the Visual Basic Editor
4. Press the keys ALT+I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL+V
7. Make any custom changes to the macro if needed at this time.
8. Save the Macro by pressing the keys CTRL+S
9. Press the keys ALT+Q to exit the Editor, and return to Excel.

To Run the Macro...
To run the macro from Excel, open the workbook, and press ALT+F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Hello moodytrane,

When I first wrote the macro, it was to add a check box without a caption that would match the cell's height. Tell me what you need and I'll modify the code for you.

Modytrane, are you familiar with Marlett checkboxes? They are easy to implement in code, and are on the same layer as the rest of the data. Here's an example:

In the sheet module:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        ' change range as desired
        Marlett Target, Range("A1:B65536"), True, 6 ' make checked cells yellow

    ' other double-click code goes here

End Sub

In a code module:

Sub Marlett(cell As Range, r As Range, _
            Optional bChangeColor As Boolean, _
            Optional iCheck As XlColorIndex = xlColorIndexNone, _
            Optional iNoCheck As XlColorIndex = xlColorIndexNone)
            
    With cell
        If .Count > 1 Or Intersect(.Cells, r) Is Nothing Then Exit Sub
        If IsEmpty(.Value) Then
            .Value = "a"
            .Font.Name = "Marlett"
            If bChangeColor Then .Interior.ColorIndex = iCheck
        Else
            .ClearContents
            If bChangeColor Then .Interior.ColorIndex = iNoCheck
        End If
    End With
End Sub

escobf,

Unfortunately you need to post your question in a new thread, it's against the forum rules to post a question in the thread of another user. If you create your own thread, any advice will be tailored to your situation so you should include a description of what you've done and are trying to do. Also, if you feel that this thread is particularly relevant to what you are trying to do, you can surely include a link to it in your new thread.