Inserting a Checkbox within a Macro

Question

Hello.  I'm working on a Macro to insert a bunch of stuff from another workbook, and to insert a checkbox to control that information.  Attached is the workbook with which I'm working. 

I have everything working correctly except for the check box function.  The problems:

1.  The checkbox inserts in a different place than I asked it to.

2.  The checkboxes to the right of the new one need to update to reflect a new target, which is always one cell to the right of the old target. 

Any Ideas? 

The code: 

Sub Macro11()

'

' Macro11 Macro

'

'

    Sheets("Sheet1").Select

    Range("B2").Select

    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

    Sheets("Scenic Stock").Select

    Range("Table14[[#Headers],[ProjectB]]").Select

    Selection.ListObject.ListColumns.Add Position:=5

    Workbooks.Open Filename:="C:\Users\Lane\Documents\Thesis\April14-01.xlsm"

    Sheets("Platform Materials").Select

    Range("B3:B12").Select

    Selection.Copy

    Windows("Material Stock.xlsm").Activate

    Sheets("Sheet1").Select

    Range("B3").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Windows("April14-01.xlsm").Activate

    Sheets("Info Bank").Select

    Range("B1").Select

    Application.CutCopyMode = False

    Selection.Copy

    Windows("Material Stock.xlsm").Activate

    Range("B2").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Windows("April14-01.xlsm").Activate

    ActiveWorkbook.Save

    ActiveWindow.Close

    Sheets("Scenic Stock").Select

    ActiveSheet.CheckBoxes.Add(383.25, 36, 72, 72).Select

    ActiveSheet.Shapes("Check Box 4").IncrementLeft -6

    ActiveSheet.Shapes("Check Box 4").IncrementTop -3

    Selection.Characters.Text = ""

    Range("E4").Select

    ActiveSheet.Shapes.Range(Array("Check Box 4")).Select

    With Selection

        .Value = xlOn

        .LinkedCell = "Sheet1!$B$13"

        .Display3DShading = False

    End With

    Range("E4").Select

    ActiveCell.FormulaR1C1 = "=IF(Sheet1!R[9]C[-3], Sheet1!R[-1]C[-3],""0"")"

    Range("E4").Select

    Selection.AutoFill Destination:=Range("Table14[Column1]"), Type:= _

        xlFillDefault

    Range("Table14[Column1]").Select

    Range("E5").Select

    ActiveCell.FormulaR1C1 = "=IF(Sheet1!R[8]C[-3], Sheet1!R[-1]C[-3],""0"")"

    Range("E6").Select

    ActiveCell.FormulaR1C1 = "=IF(Sheet1!R[7]C[-3], Sheet1!R[-1]C[-3],""0"")"

    Range("E7").Select

    ActiveCell.FormulaR1C1 = "=IF(Sheet1!R[6]C[-3], Sheet1!R[-1]C[-3],""0"")"

    Range("E8").Select

    ActiveCell.FormulaR1C1 = "=IF(Sheet1!R[5]C[-3], Sheet1!R[-1]C[-3],""0"")"

    Range("E9").Select

    ActiveCell.FormulaR1C1 = "=IF(Sheet1!R[4]C[-3], Sheet1!R[-1]C[-3],""0"")"

    Range("E10").Select

    ActiveCell.FormulaR1C1 = "=IF(Sheet1!R[3]C[-3], Sheet1!R[-1]C[-3],""0"")"

    Range("E11").Select

    ActiveCell.FormulaR1C1 = "=IF(Sheet1!R[2]C[-3], Sheet1!R[-1]C[-3],""0"")"

    Range("E12").Select

    ActiveCell.FormulaR1C1 = "=IF(Sheet1!R[1]C[-3], Sheet1!R[-1]C[-3],""0"")"

    Range("E13").Select

    ActiveCell.FormulaR1C1 = "=IF(Sheet1!RC[-3], Sheet1!R[-1]C[-3],""0"")"

    Range("E14").Select

    Sheets("Sheet1").Select

    Range("B2").Select

    Selection.Copy

    Sheets("Scenic Stock").Select

    Range("Table14[[#Headers],[Column1]]").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

End Sub

ATTACHMENT: http://www.mediafire.com/?gf252qvybju5sjs

Answer 1

This is only possible if you refer to the objects and use there properties to get the correct location.

Andreas.

Sub Macro11_AK()

  Dim WB As Workbook

  Dim CB As CheckBox

  Dim R1 As Range, R2 As Range, R1Last As Range, R2Last As Range

  'Refer to cell B2 in Sheet1

  Set R1 = Sheets("Sheet1").Range("B2")

  'Find the last used cell from the bottom

  Set R1Last = R1.Offset(Rows.Count - R1.Row).End(xlUp)

  'Insert a column

  R1.EntireColumn.Insert

  'After that R1 refers to cell C2, refer to the cells on the left side

  Set R1 = R1.Offset(0, -1)

  Set R1Last = R1Last.Offset(0, -1)

  'Do the same in Scenic Stock

  'Set R2 = Sheets("Scenic Stock").Range("Table14[[#Headers],[ProjectB]]")

  Set R2 = Sheets("Scenic Stock").Range("E3")

  Set R2Last = R2.Offset(Rows.Count - R2.Row).End(xlUp)

  R2.ListObject.ListColumns.Add Position:=5

  Set R2 = R2.Offset(0, -1)

  Set R2Last = R2Last.Offset(0, -1)

  'Open the workbook

  Set WB = Workbooks.Open("C:\Users\Lane\Documents\Thesis\April14-01.xlsm")

  'Copy some values into Sheet1

  Sheets("Platform Materials").Range("B3:B12").Copy

  R1.Offset(1).PasteSpecial Paste:=xlPasteValues

  R1 = Sheets("Info Bank").Range("B1")

  'Close it, reject changes

  WB.Close False

  Application.CutCopyMode = False

  'Insert the checkbox, same position and size as the cell

  With R2

    Set CB = .Parent.CheckBoxes.Add(.Left, .Top, .Width, .Height)

  End With

  'Setup the checkbox

  With CB

    'Check it

    .Value = xlOn

    'Refer to the last cell in Sheet1

    .LinkedCell = R1Last.Address(External:=True)

    'Remove the caption

    .Characters.Text = ""

    'Make it smaller

    CB.Width = CB.Height

    'Move it to the right side of the cell minus size of the dropdown

    CB.Left = R2.Left + R2.Width - CB.Width - 12

  End With

  'Copy the header

  R2.Value = R1.Value

  'Create the formula

  R2.Offset(1, 0).Formula = _

    "=IF(" & R1Last.Address(External:=True) & "," & _

    R1.Offset(1).Address(0, 0, External:=True) & ",0)"

  'Copy it down

  Range(R2.Offset(1, 0), R2Last).FillDown

End Sub

Answer 2

Andreas, your magic never ceases to amaze me.  Also, I appreciate that you add the notes about what is doing what within the macro.  It is very helpful to those of us who are less magical, so that we can learn.  Thanks again.