I need help Editing this Macro

[Buns1976]

Hi everyone,

New to the forum and very new to Macros. I am trying to get rid of the TRUE dialog box every time I run the macro below and not sure how to accomplish that?

Thanks in advance!!

Sub CheckBox372_Click()

    If ActiveSheet.Shapes(Application.Caller).ControlFormat.Value = 1 Then
        MsgBox Range("E2").Select
    Selection.Copy
    Range("D2").Select
    ActiveSheet.Paste
    Range("K2").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=MID(RC[-7],10,3)+RC[2]"
    Range("K2").Select
Else
        MsgBox Range("D2").Select
    Selection.ClearContents
End If
    
End Sub

 

[Buns1976]

Fluff I'm wondering if we can add a line to this macro on "UNCHECK" that would restore the original value(PRIOR to "Cells(.Row, "D").PasteSpecial xlPasteValues") in Column D?

Thanks!!

[/COLOR]Sub CHECKBOX_Y_N()   ActiveSheet.UNPROTECT "1875"
   
   Dim Shp As Shape
   
   Set Shp = ActiveSheet.Shapes(Application.Caller)
   With Shp.TopLeftCell
     If Shp.ControlFormat.Value = 1 Then
         Cells(.Row, "E").Copy
         Cells(.Row, "D").PasteSpecial xlPasteValues
         Cells(.Row, "K").FormulaR1C1 = "=MID(RC[-7],10,3)+RC[2]"
         Cells(.Row, "K").Select
      Else
         Cells(.Row, "D").ClearContents
         Cells(.Row, "K").FormulaR1C1 = "=mid(rc[-7],10,3)"
         Cells(.Row, "D").Select
      End If
    End With
    ActiveSheet.PROTECT "1875"
    
End Sub[COLOR=#574123]

 

[Fluff]

The only way to do that would be to store the values of column D somewhere.

 

[Buns1976]

The ORIGINAL value correct? If that is the case what about this! Copy/Paste the value in D to W and then DELETE after its restored so I don't have extra stuff laying around?

Thanks

 

[Fluff]

How about

Sub CHECKBOX_Y_N()
   ActiveSheet.Unprotect "1875"
   
   Dim Shp As Shape
   
   Set Shp = ActiveSheet.Shapes(Application.Caller)
   With Shp.TopLeftCell
     If Shp.ControlFormat.Value = 1 Then
         Cells(.Row, "D").Copy Cells(.Row, "W")
         Cells(.Row, "E").Copy
         Cells(.Row, "D").PasteSpecial xlPasteValues
         Cells(.Row, "K").FormulaR1C1 = "=MID(RC[-7],10,3)+RC[2]"
         Cells(.Row, "K").Select
      Else
         Cells(.Row, "D").ClearContents
         Cells(.Row, "W").Cut Cells(.Row, "D")
         Cells(.Row, "K").FormulaR1C1 = "=mid(rc[-7],10,3)"
         Cells(.Row, "D").Select
      End If
    End With
    ActiveSheet.Protect "1875"
    
End Sub

 

[Buns1976]

Fluff, my most sincere apologies. I had to step out and haven't had a chance to give this a go!
I will get with you tomorrow!!

Thanks!

 

[Buns1976]

Hi Fluff,

Ran into something urgent before I get to your last post. I run a master macro that clears the form so its ready for next use. One of the
macros is "CLEAR_CHECKBOXES. I need to include a line in that macro that would restore the original formulas in Column K to =MID(D2,10,3).
That should be similar to what happens if we manually UNCHECK a box. I've tried inserting it but am failing?

Thank you!!!

Sub CLEAR_CHECKBOXS()  Dim WS As Worksheet
  On Error Resume Next
  For Each WS In Worksheets
    WS.CheckBoxes.Value = 0
  Next
  On Error GoTo 0
 




End Sub

 

[My Aswer Is This]

I never believe needing a checkbox for 70 rows is a good plan.
Would you please explain to me what your ultimate goal is

I could provide one simple script that would run a script when you just double click on a cell

Aw sweet! That works! Thank you kindly!

I have a 2nd question and not sure if I need to start a new thread or not?

As you see this macro runs on row 2. I have 70 more rows with check boxes that require the same macro. Is there a way to copy this down or do I need to create 70 macros since they are row specific?

 

[Fluff]

How about

Sub Buns1976()
   Dim ChkBx As CheckBox
   
   For Each ChkBx In ActiveSheet.CheckBoxes
      ChkBx.Value = False
      Cells(ChkBx.TopLeftCell.Row, "K").FormulaR1C1 = "=mid(rc[-7],10,3)"
   Next ChkBx
End Sub

 

[Buns1976]

Hi Fluff,
Macro showed error at Cells(ChkBx.TopLeftCell.Row, "K").FormulaR1C1 = "=mid(rc[-7],10,3)"

Thanks

 

[Fluff]

What was the error?