Checkbox To Move One Cell Value Into Another Cell

[data808]

This will be a 2 part question.

1. Does anyone know how to insert checkboxes to go down a column indefinitely starting from the 3rd row? The first two rows will be the title headers. I know how to insert a check box and copy and paste more of them but I would like it to keep going down so that I don't have to keep repeating this process.

2. I will be typing financial amounts into column B. I would like column C to have the checkboxes. If the user checks the box I would like the value in column B for that row to be transferred to Column D for that row. If the user made a mistake by checking the box and then wants to uncheck it, I would like the value to go back to column B. So basically reverse the process.

Let me know if you need more info.

Thank you.

 

[data808]

One way to get a "raised effect" in a cell is to colour it grey to start with, then add a thick black border to the bottom & right edges of the cell only. Makes it look like a button.

Thanks. Looks pretty good for the button effect.

I noticed I can't double click any of the cells to initiate the blinking cursor anymore. Probably because of the VBA code to do the double clicking for the checkbox column. Is there a way to make it only do this for the checkbox column and not the rest of the spreadsheet? I would like to be able to double click other cells and start typing values into the cells especially if I only need to add-on or remove some of the characters and not the whole value itself.

 

[kevin9999]

Sorry, just move the cancel = True line as below:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
    On Error GoTo Escape
    Application.EnableEvents = False
    If Target.Row > 2 And Target.Column = 3 Then
    cancel = True
        If ActiveCell = "" And ActiveCell.Offset(, -1) <> "" Then
            With ActiveCell
                .Value = Chr(214)
                .Font.Name = "Symbol"
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
                .Offset(0, -1).Cut .Offset(0, 1)
            End With
        Else
            With ActiveCell
                .Offset(0, 1).Cut .Offset(0, -1)
                .ClearContents
            End With
        End If
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[data808]

Sorry, just move the cancel = True line as below:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
    On Error GoTo Escape
    Application.EnableEvents = False
    If Target.Row > 2 And Target.Column = 3 Then
    cancel = True
        If ActiveCell = "" And ActiveCell.Offset(, -1) <> "" Then
            With ActiveCell
                .Value = Chr(214)
                .Font.Name = "Symbol"
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
                .Offset(0, -1).Cut .Offset(0, 1)
            End With
        Else
            With ActiveCell
                .Offset(0, 1).Cut .Offset(0, -1)
                .ClearContents
            End With
        End If
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

Works like a charm. I am now going to add this to my existing code. I will report back if I have any issues but thank you so much for the help. This is going to be awesome.

 

[kevin9999]

Happy to help, and thanks for the feedback

 

[data808]

Happy to help, and thanks for the feedback

No problem. Thank you for helping.

I actually like how your code can clear contents based on the check mark. I altered it to this:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)

On Error GoTo Escape
Application.EnableEvents = False
If Target.Row > 5 And Target.Column = 6 Then
cancel = True
    If ActiveCell = "" And ActiveCell.Offset(, -1) <> "" Then
        With ActiveCell
            .Value = Chr(214)
            .Font.Name = "Symbol"
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .Offset(0, -1).Cut .Offset(0, 1)
        End With
    Else
        With ActiveCell
            .Offset(0, 1).Cut .Offset(0, -1)
            .ClearContents
        End With
    End If
End If

Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
    
End Sub

Would you be able to add a date stamp (MM/DD/YYYY) for yesterday's date to column 8 if a check mark is filled in column 6? If check mark is null for column 6 then column 8 is null? I would also like the user to be able to override this by manually typing over column 8 if yesterday's date does not fit their scenario. So automating it would work most times but in some situations it may not so the user would need to be able to type over the automated date.

If you want, I could also make a new thread for this if that helps you out. Just let me know and thanks again @kevin9999.

 

[kevin9999]

It'll be a small addition to your code in post #15 - leave it with me (bit busy right now)

 

[kevin9999]

Please try the following:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)

    On Error GoTo Escape
    Application.EnableEvents = False
    If Target.Row > 5 And Target.Column = 6 Then
    cancel = True
        If ActiveCell = "" And ActiveCell.Offset(, -1) <> "" Then
            With ActiveCell
                .Value = Chr(214)
                .Font.Name = "Symbol"
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
                .Offset(0, -1).Cut .Offset(0, 1)
                .Offset(0, 2).Value = Format(Date - 1, "MM/DD/YYYY")
            End With
        Else
            With ActiveCell
                .Offset(0, 1).Cut .Offset(0, -1)
                .ClearContents
                .Offset(0, 2).ClearContents
            End With
        End If
    End If
    
Continue:
        Application.EnableEvents = True
        Exit Sub
Escape:
        MsgBox "Error " & Err.Number & ": " & Err.Description
        Resume Continue
    
End Sub

 

[data808]

Please try the following:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)

    On Error GoTo Escape
    Application.EnableEvents = False
    If Target.Row > 5 And Target.Column = 6 Then
    cancel = True
        If ActiveCell = "" And ActiveCell.Offset(, -1) <> "" Then
            With ActiveCell
                .Value = Chr(214)
                .Font.Name = "Symbol"
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
                .Offset(0, -1).Cut .Offset(0, 1)
                .Offset(0, 2).Value = Format(Date - 1, "MM/DD/YYYY")
            End With
        Else
            With ActiveCell
                .Offset(0, 1).Cut .Offset(0, -1)
                .ClearContents
                .Offset(0, 2).ClearContents
            End With
        End If
    End If
   
Continue:
        Application.EnableEvents = True
        Exit Sub
Escape:
        MsgBox "Error " & Err.Number & ": " & Err.Description
        Resume Continue
   
End Sub

Thanks @kevin9999. Working great. Super helpful.