Change a Reg Box into a Combo to generate a list of options-get new VBA plug-in

**brwnrootsister** · 03-05-2014, 08:57 AM

I would like to take the Reg3 box and make it a combo box(with Appiable To data) so that I can make a selection from the list of Appicable to: when adding an new entry to the form..

Private Sub cmdOverdue_Click() 
     'error statement
On Error Goto errHandler: 
     'clear the listbox
    lstLookup.RowSource = "" 
     'clear controls
    Me.txtLookup.Value = "" 
    Me.cboStart.Value = "" 
     'add department and date range to criteria
    With Sheet2 
        .Range("P7").Value = "" 
        .Range("Q7").Value = "" 
        .Range("R7").Value = Me.cboDepartment.Value 
        .Range("O7").Value = "=""<=""&TODAY()" 
    End With 
     'run the filter
    AdvFilter 
     'check for value and adjust rowsource to avoid an error
    If Sheet2.Range("T7").Value = "" Then 
        lstLookup.RowSource = "" 
    Else 
        lstLookup.RowSource = "Filter_Staff" 
    End If 
     'error block
    On Error Goto 0 
    Exit Sub 
    errHandler:: 
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _ 
    & Err.Number & vbCrLf & Err.Description & vbCrLf & _ 
    "Please notify the administrator" 
End Sub 
 
Private Sub cmdAdd_Click() 
     'declare the valiable
    Dim nextrow As Range 
     'error handler
On Error Goto errHandler: 
    Application.ScreenUpdating = False 
     'force user to click the option button
    If Me.Reg4.Enabled = False Then 
        MsgBox "You need to click the Add Option Button" 
        Exit Sub 
    End If 
     'set the next row in the database
    Set nextrow = Sheet2.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) 
     'check for values in all controls
    If Me.Reg8.Value = "New" Or Me.Reg8.Value = "Once" Then 
        For X = 1 To 8 
            If Me.Controls("Reg" & X).Value = "" Then 
                MsgBox "You need to add the skill and first and last names" 
                Exit Sub 
            End If 
        Next 
    Else 
        For X = 1 To 10 
            If Me.Controls("Reg" & X).Value = "" Then 
                MsgBox "You need to add the skill and first and last names" 
                Exit Sub 
            End If 
        Next 
    End If 
     'check for duplicate staff
    If WorksheetFunction.CountIf(Sheet2.Range("F:F"), Me.Reg4.Value) > 0 Then 
        MsgBox "This staff member already exists" 
        Exit Sub 
    End If 
     'add value to the next row in the database
    nextrow = Reg1.Value 
    nextrow.Offset(0, 1) = Reg2.Value 
    nextrow.Offset(0, 2) = Reg3.Value 
    nextrow.Offset(0, 3) = Reg4.Value 
    nextrow.Offset(0, 4) = Reg5.Value 
    nextrow.Offset(0, 5) = Reg6.Value 
     'format the date controlls
    With nextrow 
        .Offset(0, 6).Value = Format(Reg7.Value, "mm/dd/yy") 
    End With 
    nextrow.Offset(0, 7) = Reg8.Value 
    With nextrow 
        .Offset(0, 8).Value = Format(Reg9.Value, "mm/dd/yy") 
    End With 
    nextrow.Offset(0, 9) = Reg10.Value 
     'sort the database
    Sortit 
     'set the criteria for the filter to show the department
    With Sheet2 
        .Range("P7").Value = "" 
        .Range("Q7").Value = "" 
        .Range("R7").Value = Me.Reg5.Value 
        .Range("O7").Value = "" 
    End With 
     'run the filter
    AdvFilter 
     'add the rowsource to the listbox
    lstLookup.RowSource = "Filter_Staff" 
     'clear the controls
    For X = 1 To cNum 
        Me.Controls("Reg" & X).Value = "" 
    Next 
    Me.optAdd = False 
     'error block
    On Error Goto 0 
    Exit Sub 
    errHandler:: 
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _ 
    & Err.Number & vbCrLf & Err.Description & vbCrLf & _ 
    "Please notify the administrator" 
End Sub 
Private Sub cmdTraining_Click() 
     'declare the variables
     
    Dim cNum As Integer 
    Dim nextrow As Range 
    Dim MyCell As Range 
    Dim rng As Long 
     'error handling
On Error Goto errHandler: 
     'check for values
    If Reg1.Value = "" Or Reg4.Value = "" Then 
        MsgBox "There is not data to edit" 
        Exit Sub 
    End If 
     'check for duplicates
    rng = Sheet2.Cells(Rows.Count, "F").End(xlUp).Row 
    For Each MyCell In Sheet2.Range("F7:F" & rng) 
        If MyCell = Me.Reg4.Value And MyCell.Offset(0, 2).Value = Me.Reg6.Value Then 
            MsgBox "This training already exists for this staff member" 
            Exit Sub 
        End If 
    Next MyCell 
     'check that the date is a date
    If Not IsDate(Me.Reg7) Then 
        MsgBox "Completed date must be a date format" 
        Exit Sub 
    End If 
     'find the next row to add data to
    Set nextrow = Sheet2.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) 
     'check for values in the controls
    If Me.Reg6.Value = "" Or Me.Reg7.Value = "" Or Me.Reg8.Value = "" Then 
        MsgBox "You need to add all data" 
        Exit Sub 
    End If 
     'clear the listbox
    lstLookup.RowSource = "" 
     'add the values to the database
    nextrow = Reg1.Value 
    nextrow.Offset(0, 1) = Reg2.Value 
    nextrow.Offset(0, 2) = Reg3.Value 
    nextrow.Offset(0, 3) = Reg4.Value 
    nextrow.Offset(0, 4) = Reg5.Value 
    nextrow.Offset(0, 5) = Reg6.Value 
     'format the date values on the worksheet
    With nextrow 
        .Offset(0, 6).Value = Format(Reg7.Value, "mm/dd/yy") 
    End With 
    nextrow.Offset(0, 7) = Reg8.Value 
    With nextrow 
        .Offset(0, 8).Value = Format(Reg9.Value, "mm/dd/yy") 
    End With 
    nextrow.Offset(0, 9) = Reg10.Value 
     'sort the database
    Sortit 
     'run the filter
    AdvFilter 
     'refresh the rowsource in the listbox
    lstLookup.RowSource = "" 
    lstLookup.RowSource = "Filter_Staff" 
     'error block
    On Error Goto 0 
    Exit Sub 
    errHandler:: 
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _ 
    & Err.Number & vbCrLf & Err.Description & vbCrLf & _ 
    "Please notify the administrator" 
End Sub 
Private Sub cmdEdit_Click() 
     'declare the variables
    Dim findvalue As Range, c As Range 
    Dim cNum As Integer 
     'error handling
On Error Goto errHandler: 
     'check for values
    If Reg1.Value = "" Or Reg4.Value = "" Then 
        MsgBox "There is not data to edit" 
        Exit Sub 
    End If 
     'check to see if the date is entered
    If Not IsDate(Me.Reg7) Then 
        MsgBox "Completed date must be a date format" 
        Exit Sub 
    End If 
     'clear the listbox
    lstLookup.RowSource = "" 
     'find the row to edit
    Set findvalue = Sheet2.Range("L:L").Find(What:=Reg10, LookIn:=xlValues).Offset(0, -9) 
     'update the values
    findvalue = Reg1.Value 
    findvalue.Offset(0, 1) = Reg2.Value 
    findvalue.Offset(0, 2) = Reg3.Value 
    findvalue.Offset(0, 3) = Reg4.Value 
    findvalue.Offset(0, 4) = Reg5.Value 
    findvalue.Offset(0, 5) = Reg6.Value 
     'format date values
    With findvalue 
        .Offset(0, 6).Value = Format(Reg7.Value, "mm/dd/yy") 
    End With 
    findvalue.Offset(0, 7) = Reg8.Value 
    With findvalue 
        .Offset(0, 8).Value = Format(Reg9.Value, "mm/dd/yy") 
    End With 
    findvalue.Offset(0, 9) = Reg10.Value 
     'run the filter
    AdvFilter 
     'add the new values to the listbox
    lstLookup.RowSource = "Filter_Staff" 
     'error block
    On Error Goto 0 
    Exit Sub 
errHandler: 
    MsgBox "An Error has Occurred  " & vbCrLf & _ 
    "The error number is:  " & Err.Number & vbCrLf & _ 
    Err.Description & vbCrLf & "Please notify the administrator" 
End Sub 
Private Sub optAdd_Click() 
     'what to do when the add option button is clicked
     'clear the controls
    cNum = 10 
    For X = 1 To cNum 
        Me.Controls("Reg" & X).Value = "" 
    Next 
     'enable and color first 9 controls
    cNum = 9 
    For X = 1 To cNum 
        Me.Controls("Reg" & X).BackColor = RGB(255, 255, 255) 
        Me.Controls("Reg" & X).Enabled = True 
    Next 
     'add new ID
    With Me 
        .Reg10.Value = Sheet2.Range("J2").Value + 1 
         'disable last control
        .Reg10.Enabled = False 
        .Reg10.BackColor = RGB(220, 220, 220) 
         'disable the edit button
        .cmdEdit.Enabled = False 
        .cmdEdit.BackColor = RGB(220, 220, 220) 
        .cmdTraining.Enabled = False 
        .cmdTraining.BackColor = RGB(220, 220, 220) 
         'enable the add button
        .cmdAdd.Enabled = True 
        .cmdAdd.BackColor = RGB(0, 51, 0) 
    End With 
End Sub 
Private Sub optEdit_Click() 
     'what ot do when the edit option is selected
     'disable first 6 controls and change color
    For X = 1 To 6 
        Me.Controls("Reg" & X).BackColor = RGB(220, 220, 220) 
        Me.Controls("Reg" & X).Enabled = False 
    Next 
     'enaable and diable controls
    With Me 
        .Reg7.Enabled = True 
        .Reg7.BackColor = RGB(255, 255, 255) 
        .Reg8.Enabled = True 
        .Reg8.BackColor = RGB(255, 255, 255) 
        .Reg9.Enabled = True 
        .Reg9.BackColor = RGB(255, 255, 255) 
        .Reg10.Enabled = False 
        .Reg10.BackColor = RGB(220, 220, 220) 
         'enable the edit button
        .cmdEdit.Enabled = True 
        .cmdEdit.BackColor = RGB(0, 51, 0) 
         'disable the add button and new training button
        .cmdAdd.Enabled = False 
        .cmdAdd.BackColor = RGB(220, 220, 220) 
        .cmdTraining.Enabled = False 
        .cmdTraining.BackColor = RGB(220, 220, 220) 
    End With 
End Sub 
Private Sub optTraining_Click() 
     'check for values
    If Me.Reg1.Value = "" Then 
        MsgBox "A staff member needs to be selected" 
        Me.optTraining = False 
        Exit Sub 
    End If 
     'add the ID value
    Me.Reg10.Value = Sheet2.Range("J2").Value + 1 
     'enable and disable controls
    Me.Reg10.Enabled = False 
    Me.Reg10.BackColor = RGB(220, 220, 220) 
    For X = 1 To 5 
        Me.Controls("Reg" & X).BackColor = RGB(220, 220, 220) 
        Me.Controls("Reg" & X).Enabled = False 
    Next 
    For X = 6 To 9 
        Me.Controls("Reg" & X).BackColor = RGB(255, 255, 255) 
        Me.Controls("Reg" & X).Enabled = True 
        Me.Controls("Reg" & X).Value = "" 
    Next 
     'disable and enable command buttons
    Me.cmdTraining.Enabled = True 
    Me.cmdTraining.BackColor = RGB(0, 51, 0) 
    Me.cmdEdit.Enabled = False 
    Me.cmdEdit.BackColor = RGB(220, 220, 220) 
    Me.cmdAdd.Enabled = False 
    Me.cmdAdd.BackColor = RGB(220, 220, 220) 
End Sub 
Sub Setit() 
     'disable,clear values and change the back color of all controls
    cNum = 10 
    For X = 1 To cNum 
        Me.Controls("Reg" & X).BackColor = RGB(220, 220, 220) 
        Me.Controls("Reg" & X).Enabled = False 
        Me.Controls("Reg" & X).Value = "" 
    Next 
     'clear the criteria range
    With Sheet2 
        .Range("P7").Value = "" 
        .Range("Q7").Value = "" 
        .Range("R7").Value = "" 
        .Range("O7").Value = "" 
    End With 
     'clear the listbox
    lstLookup.RowSource = "" 
     'clear the controls
    With Me 
        .txtLookup.Value = "" 
        .cboDepartment.Value = "" 
        .cboStart.Value = "" 
         'disable buttons
        .cmdTraining.Enabled = False 
        .cmdEdit.Enabled = False 
        .cmdAdd.Enabled = False 
    End With 
End Sub 
Private Sub Reg10_Change() 
End Sub 
Private Sub Reg6_AfterUpdate() 
    Dim MyCell As Range 
    Dim rng As Long 
     'check for duplicates
    rng = Sheet2.Cells(Rows.Count, "F").End(xlUp).Row 
    For Each MyCell In Sheet2.Range("F7:F" & rng) 
        If MyCell = Me.Reg4.Value And MyCell.Offset(0, 2).Value = Me.Reg6.Value Then 
            MsgBox "This training already exists for this staff member" 
            Me.Reg6.Value = "" 
            Exit Sub 
        End If 
    Next MyCell 
End Sub 
 
Private Sub Reg7_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
     'check for date value
    Me.Reg7 = Format(Me.Reg7, "mm/dd/yy") 
    If Not IsDate(Me.Reg7) Then 
        MsgBox "Completed date must be a date format" 
        Me.Reg7.Value = "" 
        Exit Sub 
    End If 
End Sub 
Private Sub Reg8_Change() 
     'add values to criteria
    Me.Reg9.Value = Format(Me.Reg9.Value, "mm/dd/yy") 
    With Sheet3 
        .Range("O7").Value = Format(Me.Reg7.Value, "mm/dd/YY") 
        .Range("P7").Value = Me.Reg8.Value 
    End With 
    Me.Reg9.Value = Format(Sheet3.Range("Q7").Value, "mm/dd/yy") 
End Sub 
Private Sub Reg9_Change() 
    Me.Reg9 = Format(Me.Reg9, "mm/dd/yy") 
End Sub 
 
Private Sub UserForm_Initialize() 
     'format the control
    Me.Reg7 = Format(Me.Reg7, "mm/dd/yy") 
    Me.Reg9 = Format(Me.Reg9, "mm/dd/yy") 
    cNum = 10 
    For X = 1 To cNum 
        Me.Controls("Reg" & X).BackColor = RGB(220, 220, 220) 
        Me.Controls("Reg" & X).Enabled = False 
        Me.Controls("Reg" & X).Value = "" 
    Next 
    With Me 
         'clear the listbox
        Me.lstLookup.RowSource = "" 
         'disable ID
        Me.Reg4.Enabled = False 
         'change the back color
        Me.Reg4.BackColor = RGB(220, 220, 220) 
         'disable controls
        Me.cmdEdit.Enabled = False 
        Me.cmdEdit.BackColor = RGB(220, 220, 220) 
        Me.cmdAdd.Enabled = False 
        Me.cmdAdd.BackColor = RGB(220, 220, 220) 
        Me.cmdTraining.Enabled = False 
        Me.cmdTraining.BackColor = RGB(220, 220, 220) 
    End With 
    AdvFilter 
End Sub

**Norie** · 03-05-2014, 09:07 AM

Should be straightforward, just remove the textbox, put a combobox in its place and add code to populate it in the form's Initialize event.

**brwnrootsister** · 03-05-2014, 11:55 AM

Thanks, let me try that!

**Norie** · 03-05-2014, 01:02 PM

If you need any specific help post back with more details.

For example where do the Applicable To dates come from in the workbook/worksheet?

**brwnrootsister** · 03-06-2014, 12:47 AM

I followed the instruction that you gave me and I get a code stating :> could not set the RowSource property,. Invalid property value. I added the row source that I anted the list of items to come from. Please advise

**brwnrootsister** · 03-06-2014, 12:52 AM

Ok I went in and gave it a name under the name manger function but it still does not give me the option to select from the from drown box.

Change a Reg Box into a Combo to generate a list of options-get new VBA plug-in

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Change a Reg Box into a Combo to generate a list of options-get new VBA plug-in

Re: Change a Reg Box into a Combo to generate a list of options-get new VBA plug-in

Re: Change a Reg Box into a Combo to generate a list of options-get new VBA plug-in

Re: Change a Reg Box into a Combo to generate a list of options-get new VBA plug-in

Re: Change a Reg Box into a Combo to generate a list of options-get new VBA plug-in

Re: Change a Reg Box into a Combo to generate a list of options-get new VBA plug-in

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Excel 2010 VBA – Combo Box Options– Clear cell/box in 2nd Combo when 1st Combo selected

combo list change of items

Using a list to plug into one cell with formula

Change linking using a list/combo box

change list in combo box

Bookmarks

Bookmarks

Posting Permissions