Add code to a dynamically created Commandbutton

[Kirnon]

Hi,

Once again I hit a brick wall after having spent all morning trying to figure it out I come to you, MrExcel Forumites.

Below I present my code thus far - it all works as intended. What I need to now do is add the following line to the Command Button created in the code -

UserForm2.Show

Simple enough one would think. But due to the dynamic nature of the buttons name I am hitting a brick wall.

Please help.

Sub New_Applicant()
Dim shp As Shape
NewRow = Sheets("Applications").Cells(Rows.Count, 2).End(xlUp).Row + 1
OldRow = Sheets("Applications").Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Sheets("Applications").Range("A" & NewRow)
With Sheets("Applications")
    .Range("A" & OldRow & ":BM" & OldRow).Copy
    .Range("A" & NewRow & ":BM" & NewRow).PasteSpecial xlAll
    .Range("B" & NewRow & ",T" & NewRow & ",AL" & NewRow & ":AN" & NewRow & ",AP" _
                & NewRow & ":BM" & NewRow).ClearContents
    .Range("B" & NewRow & ":B" & NewRow) = UserForm1.TextBox1.Value
    .Range("J" & NewRow & ":J" & NewRow) = UserForm1.TextBox2.Value
    .OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=Rng.Left, Top:=Rng.Top, _
        Width:=Rng.Width, Height:=Rng.RowHeight).Select
    Set shp = ActiveSheet.Shapes(Selection.Name)
    With shp.OLEFormat.Object
        .Object.Caption = ""
    End With
    shp.Name = "Add" & NewRow
End With
End Sub

 

[VBA Geek]

Sub New_Applicant()
Dim shp As Shape, NewRow As Long, OldRow As Long, Rng As Excel.Range
NewRow = Sheets("Applications").Cells(Rows.Count, 2).End(xlUp).Row + 1
OldRow = Sheets("Applications").Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Sheets("Applications").Range("A" & NewRow)
With Sheets("Applications")
    .Range("A" & OldRow & ":BM" & OldRow).Copy
    .Range("A" & NewRow & ":BM" & NewRow).PasteSpecial xlAll
    .Range("B" & NewRow & ",T" & NewRow & ",AL" & NewRow & ":AN" & NewRow & ",AP" _
                & NewRow & ":BM" & NewRow).ClearContents
    .Range("B" & NewRow & ":B" & NewRow) = UserForm1.TextBox1.Value
    .Range("J" & NewRow & ":J" & NewRow) = UserForm1.TextBox2.Value
    .OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=Rng.Left, Top:=Rng.Top, _
        Width:=Rng.Width, Height:=Rng.RowHeight).Select
    Set shp = ActiveSheet.Shapes(Selection.Name)
    With shp.OLEFormat.Object
        .Object.Caption = ""
    End With
    shp.Name = "Add" & NewRow
End With
[B][COLOR=#b22222][SIZE=2]With ThisWorkbook.VBProject.VBComponents(Sheets("Applications").CodeName).CodeModule
    .InsertLines .CreateEventProc("Click", "Add" & NewRow) + 1, "UserForm2.Show"
End With[/SIZE][/COLOR][/B]
End Sub

ps. you need to have Trust Access to the VBA project object model

 

[Kirnon]

You sir, are a flippin' genius. That has done the trick wonderfully. except for one small hiccup. It keeps opening up the VBA project model which obviously I need to ensure doesn't happen for the end user. Do you know why this is happening and perhaps how to stop it?

 

[mikerickson]

It looks like you are adding an ActiveX command button right above the cell rng.
You could:
1) Dispense with controls altogether. Instead of pressing a command button to trigger the routine, the user could double click the cell rng.

2) Use a button from the Forms menu, linked to a preexisting macro.

With rng
    With .Parent.Buttons.Add(.Left, .Top, .Width, .Height)
        .OnAction = "myMacro"
        .Visible = True
    End With
End With

 

[Kirnon]

@mikerikson: That is a much better option than all the hoops I have been trying to jump through for this code.

Thank you for that.