Sub New_Product()
Dim r As Range
Dim myCBX As CheckBox
Dim myCell As Range
Application.ScreenUpdating = False
Set r = ActiveSheet.Shapes(Application.Caller).TopLeftCell
Cells(r.Row, r.Column).Resize(4, 1).EntireRow.Insert
Cells(r.Row, r.Column).Offset(-8, 0).Resize(4, 8).Copy
Cells(r.Row, r.Column).Offset(-4, 0).Resize(4, 8).PasteSpecial
Application.CutCopyMode = False
Cells(r.Row, r.Column).Offset(-3, 3).Value = ""
Cells(r.Row, r.Column).Offset(-3, 3).Select
SendKeys "{F2}", True
SendKeys "{ENTER}", True
Cells(r.Row, r.Column).Offset(-2, 3).Value = "Select..."
Cells(r.Row, r.Column).Offset(-2, 3).Select
SendKeys "{F2}", True
SendKeys "{ENTER}", True
Cells(r.Row, r.Column).Offset(-4, 2).Value = "Select..."
Cells(r.Row, r.Column).Offset(-4, 2).Select
SendKeys "{F2}", True
SendKeys "{ENTER}", True
Cells(r.Row, r.Column).Offset(-4, 4).Value = ""
Cells(r.Row, r.Column).Offset(-4, 5).Value = ""
Cells(r.Row, r.Column).Offset(-1, 3).Resize(1, 2).Value = ""
Cells(r.Row, r.Column).Offset(-4, 0).Value = Cells(r.Row, r.Column).Offset(-8, 0).Value + 1
Cells(r.Row, "H").Formula = "=SUM(H17:H" & r.Row - 1 & ")"
Set myCell = Cells(r.Row, r.Column).Offset(-2, 1)
With myCell
Set myCBX = .Parent.CheckBoxes.Add _
(Top:=.Top, Width:=.Width, _
Left:=.Left, Height:=.Height)
With myCBX
.Caption = ""
End With
End With
Application.ScreenUpdating = True
End Sub
Bookmarks