Change Large Quantity of Check Boxes to Relative Link instead of Absolute

[Neuner]

I have a database of 4,000+ contacts and have check boxes next to each name in order to select for processing / copying, etc. Check boxes are in Column C and linked to Column AU after each contact's data. I want to use Check Boxes for as fast as possible selection of a contact.

I manually copied and pasted the check boxes next to each contact and then used the following macro to change the link to each;

Sub CheckBoxLinkCorrection()    Dim cb As CheckBox
    For Each cb In ActiveSheet.CheckBoxes
        If Not Intersect(Selection, cb.TopLeftCell) Is Nothing Then
            cb.LinkedCell = Cells(cb.TopLeftCell.Row, Range(cb.LinkedCell).Column).Address
        End If
    Next
End Sub

This works great if everything were to remain static however we frequently add, delete or move contacts. In addition, I have the ability to sort based on name, company name, category assignment, last update, etc and need for the checkbox link to move with it. The link currently starts with =$AU$3 and I need for it to be =$AU3 or =AU3. Am I able to change the above macro so that links are relative instead of absolute?

Thank you!

 

[Domenic]

Try...

.Address(RowAbsolute:=false, ColumnAbsolute:=true)

Hope this helps!

 

[Neuner]

Yes! Thank you.

 

[Neuner]

Well, it worked great but didn't help what I'm ultimately trying to do.

When I sort the database, whether or not the check box link is absolute or relative, it doesn't sort with it.

Code for sorting;

Sub SortCompanyName()With Worksheets("Master")
    With .Range(.Cells(.Range("BorderFirstRow").Row + 1, "A"), _
                .Cells(.Range("BorderLastRow").Row - 1, "AT"))
        .Sort Key1:=.Cells(1, "D"), Order1:=xlAscending, _
              Key2:=.Cells(1, "F"), Order2:=xlAscending, _
              Orientation:=xlTopToBottom, Header:=xlNo
    End With
End With
End Sub

If I check the box next to the contact on Row 3 and then sort the list by company name, the contact information may have moved to Row 1894 but the check box is still linked to Row 3. Is there anyway of changing this or is this just a negative of using check boxes?

 

[Domenic]

When defining your sort range, include the column being linked to, which looks like is Column AU...

 

[Neuner]

When defining your sort range, include the column being linked to, which looks like is Column AU...

Yes, thank you, I caught that error and moved the check box link to a column within range, AS. Still, the Check Box Format Control Cell Link stays linked to the pre-sort cell whether it is absolute or relative and I have no idea why.

 

[Neuner]

Since I was having so many issues with the check box route, I did a search for alternatives. I wanted to give credit to this developer and suggestion. Hopefully this is acceptable to post:

http://www.vbaexpress.com/kb/getarticle.php?kb_id=879#instr

This has turned out to be wonderful for my application and negate all of the issues I was having. Double click a cell to assign a check mark that can be referenced and another double click to clear:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
     'Limit Target count to 1
    If Target.Count > 1 Then Exit Sub 
     'Isolate Target to a specific range
    If Intersect(Target, Range("myChecks")) Is Nothing Then Exit Sub 
     'set Target font tp "marlett"
    Target.Font.Name = "marlett" 
     'Check value of target
    If Target.Value <> "a" Then 
        Target.Value = "a" 'Sets target Value = "a"
        Cancel = True 
        Exit Sub 
    End If 
    If Target.Value = "a" Then 
        Target.ClearContents 'Sets Target Value = ""
        Cancel = True 
        Exit Sub 
    End If 
End Sub

For my instance, I modified it so that you can dbl click to check mark, dbl click again to mark an 'X' and then a third dbl click to clear the cell. This has worked wonders for my application.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)    'Limit Target count to 1
    If Target.Count > 1 Then Exit Sub
    'Isolate Target to a specific range
    If Intersect(Target, Range("SelectionMaster")) Is Nothing Then Exit Sub
    'set Target font tp "marlett"
    Target.Font.Name = "marlett"
    'Check value of target
    If Target.Value < "a" Then
        Target.Value = "a" 'Sets target Value = "a"
        Cancel = True
        Exit Sub
    End If
    If Target.Value = "a" Then
        Target.Value = "r"
        Cancel = True
        Exit Sub
    End If
    If Target.Value = "r" Then
        Target.ClearContents 'Sets Target Value = ""
        Cancel = True
        Exit Sub
    End If
    End Sub