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

 

[Exceladd1ct]

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
        '[COLOR=#ff0000]MsgBox Range("E2").Select[/COLOR]
    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
        '[COLOR=#ff0000]MsgBox Range("D2").Select  [/COLOR] 
    Selection.ClearContents
End If
    
End Sub

Try commenting or removing those 2 lines of code.

 

[Buns1976]

I tried deleting those 2 lines BUT then the macro doesn't do what is expected. Not sure what you mean be "commenting"?

 

[Exceladd1ct]

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
        [COLOR=#ff0000]Range("E2").Select[/COLOR]
    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
        [COLOR=#ff0000]Range("D2").Select[/COLOR]
    Selection.ClearContents
End If
    
End Sub

Then please try by just removing the "MsgBox" Function.

 

[Buns1976]

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?

 

[Exceladd1ct]

That depends, you could just copy this code to each checkbox Sub, and modify the cell ranges as per your needs.

 

[Buns1976]

Thats what I was afraid of! LOL Any other solutions to this as you indicated "That depends"?

 

[Fluff]

You could assign this macro to all the checkboxes

Sub Buns1976()
   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")
         Cells(.Row, "K").FormulaR1C1 = "=MID(RC[-7],10,3)+RC[2]"
         Cells(.Row, "K").Select
      Else
         Cells(.Row, "D").ClearContents
      End If
    End With
End Sub

The top left corner of the checkbox needs to be on the row it should work on

 

[Buns1976]

Fluff, I messed something up on my Macro. I failed to appreciate that the "Uncheck" part wasn't restoring a formula so now I have the macro below however when debugging I am getting the compile error "Else without if"? Once that get fixed how does that play into your solution in the previous post?

Sub CheckBox373_Click()

     Range("E2").Select
    Selection.Copy
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K2").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=MID(RC[-7],10,3)+RC[2]"
    Range("D2").Select
Else
       Range("D2").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    Range("U2").Select
    Selection.Copy
    Range("K2").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("D2").Select
End If
    
End Sub

 

[Fluff]

Try the code I posted & if it works we can then modify it.
Lets get that sorted first.