0

Briefly:

  • Userform is created
  • Based on situation, a frame is created with a textbox and button
  • Unsure if I can add code to the button that is dynamically created.

A more in-detail explanation: I'm working on a game that allows people to buy and sell stocks to see how they would manage a real portfolio. The sheet is managed by one person who inputs all the data for the players.

I am however running into a small issue. On my sheet there is a "Sell" and "Buy" button.

  1. A player can start with any number of stocks. They must sell a stock, before they can buy one.
  2. When the manager presses the Buy button, it brings up a userform with a drop down list to pick which player they want to do a purchase for.
  3. Once a player has been selected, the code will check to ensure the player has a sold position before allowing a buy to take place.
  4. If a stock has been sold, I have a frame in place which brings up the next part of the form which asks for a stock code to be entered.It also has a "submit" button which gets created.

My issue is, I don't know how to add code to the new submit button. Normally it would be something along the lines of

Private Sub newbutton_click()

However I cannot get it to work.

Here are the codes broken down.

First the userform gets initialised:

Option Explicit
Option Compare Text

Private Sub UserForm_initialize()
Dim i As Integer, j As Integer
Dim pn As String, s1 As String, s2 As String, s3 As String
Dim name As Range, code As Range
Dim lastrow As Integer
Dim username As Range
Dim names() As String, allnames() As String
Dim fr1 As Integer, lr1 As Integer, lr2 As Integer
Dim startv As String, curv As Integer, un, pr
Dim count As Integer


With ThisWorkbook.ActiveSheet.Range("A:Z")
    Set username = .find(What:="Players", after:=.Cells(.Cells.count), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

    fr1 = username.Row + 1
    lr1 = .Cells(.Rows.count, username.Column).End(xlUp).Row

    ReDim Preserve names(fr1 To lr1)
    For i = fr1 To lr1
        If Cells(i, username.Column) <> "" Then
            names(i) = Cells(i, username.Column)
        End If
    Next i

    j = 0
    ReDim Preserve allnames(1 To UBound(names))

    For i = LBound(names) To UBound(names)
        If names(i) <> "" Then
            j = j + 1
            allnames(j) = names(i)
        End If
    Next i

    ReDim Preserve allnames(LBound(allnames) To j)

    For i = LBound(allnames) To UBound(allnames)
        Buy.namebox2.AddItem allnames(i)
    Next i

End With
End Sub

The next part here finds the user that the manager selects and checks to see if a stock has been sold before allowing one to be bought.

Private Sub commandbutton1_click()
Dim newLbl As MSForms.Label
Dim newTxt As MSForms.Control
Dim newTxt1 As MSForms.Control
Dim newbut As MSForms.Control
Dim i As Integer, TopAmt
Dim fr1 As Integer, lr1 As Integer
Dim j As Integer, lr As Integer
Dim UserArray As Variant
Dim start As Integer
Dim username As Range, code As Range, selval As Range
Dim firstrow As Integer, lastrow As Integer
Dim names() As String, allnames() As String

With ThisWorkbook.ActiveSheet.Range("A:Z")
    Set username = .find(What:=namebox2.value, after:=.Cells(.Cells.count), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    Set code = .find(What:="Stock Code", after:=.Cells(.Cells.count), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    Set selval = .find(What:="Sell Value", after:=.Cells(.Cells.count), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

    If username Is Nothing Then
        MsgBox "Please select a player"
        Exit Sub
    End If

    fr1 = username.Row + 1
    lr1 = .Cells(.Rows.count, code.Column).End(xlUp).Row

    For i = fr1 To lr1
        If Cells(i, code.Column) = "TOTAL" Then
            lr = i
            Exit For
        End If
    Next i
End With

For i = fr1 To (lr - 1)
    If Cells(i, selval.Column) <> "" Then
        MsgBox "found a sold stock " & Cells(i, selval.Column)
        GoTo line1
    ElseIf i = (lr - 1) And Cells(i, selval.Column) = "" Then
        MsgBox "no stocks have been sold yet."
        Exit Sub
    End If
Next i

line1:

TopAmt = 10

Set newTxt = Frame1.Controls.Add(bstrProgID:="Forms.Label.1", name:="Label1")
        With newTxt
            .name = "Label1"
            .top = TopAmt
            .Caption = "Please enter the stock you wish to buy."
            .Visible = True
            .Width = 150
        End With
        TopAmt = TopAmt + newTxt.Height

Set newTxt1 = Frame1.Controls.Add(bstrProgID:="Forms.Textbox.1", name:="Textbox1")
        With newTxt1
            .name = "Textbox1"
            .top = TopAmt
            .Visible = True
            .Width = 120
            .MaxLength = 3
        End With
        TopAmt = TopAmt + newTxt1.Height

Set newbut = Frame1.Controls.Add(bstrProgID:="Forms.commandbutton.1", name:="commandbutton1")
        With newbut
            .name = "commandbutton1"
            .top = TopAmt
            .Visible = True
            .Width = 120
            .Caption = "Submit"
        End With
        TopAmt = TopAmt + newbut.Height

End Sub

So I create the 'newbut' and need to add code to it for when the player clicks it. I just don't know if it is possible or not.

Thank you in advance and appreciate any input.

Manu221
  • 41
  • 10
  • 1
    read this thread : https://stackoverflow.com/questions/3014421/how-to-add-events-to-controls-created-at-runtime-in-excel-with-vba – cyboashu Feb 13 '18 at 01:25
  • Have the preset buttons in a frame (move outside/hide on form initialise), then move/unhide into view when required? – PatricK Feb 13 '18 at 03:09
  • @cyboashu thanks for that. – Manu221 Feb 13 '18 at 03:58
  • @PatricK I thought of that. I had done it previously like that, but thought I would try and see if anyone else has tried it before. – Manu221 Feb 13 '18 at 03:58
  • The Classes and stuff is ok for small amount of buttons on the go, for large amount with different Subs, I rather had them un/hide. – PatricK Feb 13 '18 at 05:07

0 Answers0