Pull data from a different worksheet in dropdown boxes after selecting the NEW record command button

W

wstring

New Member
Joined
Jun 6, 2013
Messages
18
I have a user form with a search combo box that fills text and other combo boxes with data from a specific worksheet. When I select the "New" command button I'm trying to fill the combo boxes with data from another worksheet.

Code: 
Option Explicit
Private Sub UserForm_Activate()
    cmdNew.Enabled = True
    cmdClear.Enabled = False
    cmdSave.Enabled = False
    cmdDelete.Enabled = False
    cmdUpdate.Enabled = False
        
    LoadDataList
End Sub
Private Function LoadDataList() As Boolean
    Dim Ws As Worksheet
    Dim Rng As Range
    Dim C As Range
    Dim Data As Object
    Dim k As Variant
    
    Set Data = CreateObject("System.Collections.ArrayList")
    
'Get Records definition
    Set Ws = ThisWorkbook.Worksheets("LDataBaseCabinets")
    Set Rng = Ws.Range("A:A")
    
'clear combobox
    cboSearch.Clear
'load array
    For Each C In Rng.Cells
        If C.Value <> "" Then
            Data.Add C.Value
        End If
    Next
    
'Sort array
    Data.Sort
    
    For Each k In Data
        
            cboSearch.AddItem k
      
    Next
    
    Set Rng = Nothing
    Set Ws = Nothing
    Set Data = Nothing
End Function
Private Sub cboSearch_AfterSave()
'Every change of the dropdown get the value
    Dim findString As String
    Dim iRow As Integer
    Dim Rng As Range
    Dim Ws As Worksheet
    Set Ws = Worksheets("LDataBaseCabinets")
    findString = cboSearch.Text
    lblRowID.Caption = ""
    If findString <> "" Then
        With Sheets("LDataBaseCabinets").Range("A:A")
            Set Rng = .Find(What:=findString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                'store found row in lblRowID, a hidden field on form
                lblRowID.Caption = Rng.Row
            End If
        End With
    End If
    If lblRowID.Caption <> "" Then
'load values on form
iRow = Val(lblRowID.Caption)
    Me.tbxNumber.Value = Ws.Cells(iRow, 1).Value
    Me.tbxStyle.Value = Ws.Cells(iRow, 2).Value
    Me.cboCab1.Value = Ws.Cells(iRow, 3).Value
    Me.cboCab2.Value = Ws.Cells(iRow, 4).Value
    Me.cboCab3.Value = Ws.Cells(iRow, 5).Value
    Me.cboCab4.Value = Ws.Cells(iRow, 6).Value
    Me.cboCab5.Value = Ws.Cells(iRow, 7).Value
    Me.cboCab6.Value = Ws.Cells(iRow, 8).Value
    Me.cboCab7.Value = Ws.Cells(iRow, 9).Value
    Me.cboCab8.Value = Ws.Cells(iRow, 10).Value
    Me.cboCab9.Value = Ws.Cells(iRow, 11).Value
    Me.cboCab10.Value = Ws.Cells(iRow, 12).Value
        
    cmdNew.Enabled = False
    cmdClear.Enabled = True
    cmdSave.Enabled = True
    cmdDelete.Enabled = True
    cmdUpdate.Enabled = False
    
Set Ws = Nothing
End If
End Sub
Private Sub cboSearch_DropButt*******()
'Every change of the dropdown get the value
    Dim findString As String
    Dim iRow As Integer
    Dim Rng As Range
    Dim Ws As Worksheet
    Set Ws = Worksheets("LDataBaseCabinets")
    findString = cboSearch.Text
    lblRowID.Caption = ""
    If findString <> "" Then
        With Sheets("LDataBaseCabinets").Range("A:A")
            Set Rng = .Find(What:=findString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                'store found row in lblRowID, a hidden field on form
                lblRowID.Caption = Rng.Row
            End If
        End With
    End If
    If lblRowID.Caption <> "" Then
'load values on form
iRow = Val(lblRowID.Caption)
    Me.tbxNumber.Value = Ws.Cells(iRow, 1).Value
    Me.tbxStyle.Value = Ws.Cells(iRow, 2).Value
    Me.cboCab1.Value = Ws.Cells(iRow, 3).Value
    Me.cboCab2.Value = Ws.Cells(iRow, 4).Value
    Me.cboCab3.Value = Ws.Cells(iRow, 5).Value
    Me.cboCab4.Value = Ws.Cells(iRow, 6).Value
    Me.cboCab5.Value = Ws.Cells(iRow, 7).Value
    Me.cboCab6.Value = Ws.Cells(iRow, 8).Value
    Me.cboCab7.Value = Ws.Cells(iRow, 9).Value
    Me.cboCab8.Value = Ws.Cells(iRow, 10).Value
    Me.cboCab9.Value = Ws.Cells(iRow, 11).Value
    Me.cboCab10.Value = Ws.Cells(iRow, 12).Value
        
    cmdNew.Enabled = False
    cmdClear.Enabled = True
    cmdSave.Enabled = True
    cmdDelete.Enabled = True
    cmdUpdate.Enabled = False
    
End If
End Sub
Private Sub cmdNew_Click()
'this clears the combo box and disables it
'it also clears the form fields
'clear the data
    Me.cboSearch = ""
    Me.tbxNumber = ""
    Me.tbxStyle = ""
    Me.cboCab1 = ""
    Me.cboCab2 = ""
    Me.cboCab3 = ""
    Me.cboCab4 = ""
    Me.cboCab5 = ""
    Me.cboCab6 = ""
    Me.cboCab7 = ""
    Me.cboCab8 = ""
    Me.cboCab9 = ""
    Me.cboCab10 = ""
    Me.lblRowID = ""
    cboSearch.Text = "<create model="" new="">"
    tbxNumber.SetFocus
    cboSearch.Enabled = False
    cboCab1.Enabled = True
    cboCab2.Enabled = True
    cboCab3.Enabled = True
    cboCab4.Enabled = True
    cboCab5.Enabled = True
    cboCab6.Enabled = True
    cboCab7.Enabled = True
    cboCab8.Enabled = True
    cboCab9.Enabled = True
    cboCab10.Enabled = True
    
    cmdNew.Enabled = False
    cmdSave.Enabled = True
    cmdClear.Enabled = True
    cmdDelete.Enabled = False
    cmdUpdate.Enabled = False
                
End Sub
Private Sub cmdClear_Click()
'clear the data
    Me.cboSearch = ""
    Me.tbxNumber = ""
    Me.tbxStyle = ""
    Me.cboCab1 = ""
    Me.cboCab2 = ""
    Me.cboCab3 = ""
    Me.cboCab4 = ""
    Me.cboCab5 = ""
    Me.cboCab6 = ""
    Me.cboCab7 = ""
    Me.cboCab8 = ""
    Me.cboCab9 = ""
    Me.cboCab10 = ""
    
    cboSearch.Value = ""
    cboSearch.Enabled = True
    cboSearch.SetFocus
    cmdNew.Enabled = True
    cmdClear.Enabled = False
    cmdSave.Enabled = False
    cmdDelete.Enabled = False
    cmdUpdate.Enabled = False
    
End Sub
Private Sub cmdDelete_Click()
'This will allow the deleting of a Ticket record by using the Ticket row on the sheet
    Dim iRow As Integer
    'Prompt user its ok to delete
    If MsgBox("Are you sure you want to delete this Model?", vbYesNo) = vbYes Then
        'Then delete row
        'Set row based on drop down in Search Model Number drop down
        iRow = Val(lblRowID.Caption)
        Worksheets("LDataBaseCabinets").Rows(iRow).EntireRow.Delete
    Else
        Exit Sub    'Exit back to screen
    End If
    'clear the data
    Me.tbxNumber = ""
    Me.tbxStyle = ""
    Me.cboCab1 = ""
    Me.cboCab2 = ""
    Me.cboCab3 = ""
    Me.cboCab4 = ""
    Me.cboCab5 = ""
    Me.cboCab6 = ""
    Me.cboCab7 = ""
    Me.cboCab8 = ""
    Me.cboCab9 = ""
    Me.cboCab10 = ""
    
    Me.cboSearch.Enabled = True
    Me.cboSearch.SetFocus
    Me.cboSearch.Value = ""
    cmdNew.Enabled = True
    cmdClear.Enabled = False
    cmdSave.Enabled = False
    cmdDelete.Enabled = False
    cmdUpdate.Enabled = False
    
End Sub
Private Sub CmdSave_Click()
    Dim Ws As Worksheet
    Set Ws = Worksheets("LDataBaseCabinets")
    'This will update a Model record
    'It sends the rowID to the form. A Blank row means ADD
    Dim iRow As Integer
    'Set row based on drop down in Search Model Number drop down
    iRow = Val(lblRowID.Caption)
    'check if row found or adding
    If iRow = 0 Then    'new Model
        'find first empty row in database
        iRow = Ws.Cells(Rows.Count, 1) _
               .End(xlUp).Offset(1, 0).Row
    End If
    'copy the data to the database
    Ws.Cells(iRow, 1).Value = Me.tbxNumber.Value
    Ws.Cells(iRow, 2).Value = Me.tbxStyle
    Ws.Cells(iRow, 3).Value = Me.cboCab1.Value
    Ws.Cells(iRow, 4).Value = Me.cboCab2.Value
    Ws.Cells(iRow, 5).Value = Me.cboCab3.Value
    Ws.Cells(iRow, 6).Value = Me.cboCab4.Value
    Ws.Cells(iRow, 7).Value = Me.cboCab5.Value
    Ws.Cells(iRow, 8).Value = Me.cboCab6.Value
    Ws.Cells(iRow, 9).Value = Me.cboCab7.Value
    Ws.Cells(iRow, 10).Value = Me.cboCab8.Value
    Ws.Cells(iRow, 11).Value = Me.cboCab9.Value
    Ws.Cells(iRow, 12).Value = Me.cboCab10.Value
    
    'clear the data
    Me.tbxNumber = ""
    Me.tbxStyle = ""
    Me.cboCab1 = ""
    Me.cboCab2 = ""
    Me.cboCab3 = ""
    Me.cboCab4 = ""
    Me.cboCab5 = ""
    Me.cboCab6 = ""
    Me.cboCab7 = ""
    Me.cboCab8 = ""
    Me.cboCab9 = ""
    Me.cboCab10 = ""
    
    Me.cboSearch.Enabled = True
    Me.cboSearch.Value = ""
    Me.cboSearch.SetFocus
    cmdNew.Enabled = True
    cmdClear.Enabled = False
    cmdSave.Enabled = False
    cmdDelete.Enabled = False
    cmdUpdate.Enabled = False
    
    LoadDataList
    Set Ws = Nothing
End Sub
Private Sub CmdClose_Click()
    Unload Me
End Sub
Private Sub cboCab1_Change()
    Dim Ws As Worksheet
    Dim myRange As Range
    Dim oData As Object
    Dim R As Range
    
    Dim i As Long
    Dim iLastRowUsed As Long
    Dim sRange As String
    Dim sValue As String
  
    Set oData = CreateObject("System.Collections.ArrayList")
    
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    cboCab1.RowSource = ""
    iLastRowUsed = Ws.Columns("A").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'A'
    sRange = "A2:A" & iLastRowUsed
    Set myRange = Ws.Range(sRange)
    'load array
    For Each R In myRange
      sValue = CStr(Trim(R.Value))      'Remove leading/trailing spaces and make sure the data is a string value
      oData.Add sValue
    Next
    
    'Look at the data during Software Development before sorting in the Immediate Window (CTRL G in debugger)
    Debug.Print oData.Count
    For i = 0 To oData.Count - 1
      Debug.Print oData(i)
    Next i
    
    'Sort array
    oData.Sort
    'Put the values in the ComboBox
    For i = 0 To oData.Count - 1
      cboCab1.AddItem oData(i)
    Next i
    'Clear object pointers
    Set myRange = Nothing
    Set Ws = Nothing
    Set oData = Nothing
End Sub
Private Sub cboCab1_DropButt*******()
    
    Dim Ws As Worksheet
    Dim iLastRowUsed As Long
    Dim sRowSource As String
  
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    iLastRowUsed = Ws.Columns("A").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'A'
    sRowSource = "'LBaseCabinets'!A2:A" & iLastRowUsed
        
    'Populate the ComboBoxes
    cboCab1.RowSource = sRowSource
        
    'Clear object pointers
    Set Ws = Nothing
End Sub
Private Sub cboCab2_Change()
    Dim Ws As Worksheet
    Dim myRange As Range
    Dim oData As Object
    Dim R As Range
    
    Dim i As Long
    Dim iLastRowUsed As Long
    Dim sRange As String
    Dim sValue As String
  
    Set oData = CreateObject("System.Collections.ArrayList")
    
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    cboCab2.RowSource = ""
    iLastRowUsed = Ws.Columns("H").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'H'
    sRange = "H2:H" & iLastRowUsed
    Set myRange = Ws.Range(sRange)
    'load array
    For Each R In myRange
      sValue = CStr(Trim(R.Value))      'Remove leading/trailing spaces and make sure the data is a string value
      oData.Add sValue
    Next
    
    'Look at the data during Software Development before sorting in the Immediate Window (CTRL G in debugger)
    Debug.Print oData.Count
    For i = 0 To oData.Count - 1
      Debug.Print oData(i)
    Next i
    
    'Sort array
    oData.Sort
    'Put the values in the ComboBox
    For i = 0 To oData.Count - 1
      cboCab2.AddItem oData(i)
    Next i
    'Clear object pointers
    Set myRange = Nothing
    Set Ws = Nothing
    Set oData = Nothing
End Sub
Private Sub cboCab2_DropButt*******()
    
    Dim Ws As Worksheet
    Dim iLastRowUsed As Long
    Dim sRowSource As String
  
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    iLastRowUsed = Ws.Columns("H").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'H'
    sRowSource = "'LBaseCabinets'!H2:H" & iLastRowUsed
        
    'Populate the ComboBoxes
    cboCab2.RowSource = sRowSource
        
    'Clear object pointers
    Set Ws = Nothing
End Sub
Private Sub cboCab3_Change()
    Dim Ws As Worksheet
    Dim myRange As Range
    Dim oData As Object
    Dim R As Range
    
    Dim i As Long
    Dim iLastRowUsed As Long
    Dim sRange As String
    Dim sValue As String
  
    Set oData = CreateObject("System.Collections.ArrayList")
    
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    cboCab3.RowSource = ""
    iLastRowUsed = Ws.Columns("O").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'O'
    sRange = "O2:O" & iLastRowUsed
    Set myRange = Ws.Range(sRange)
    'load array
    For Each R In myRange
      sValue = CStr(Trim(R.Value))      'Remove leading/trailing spaces and make sure the data is a string value
      oData.Add sValue
    Next
    
    'Look at the data during Software Development before sorting in the Immediate Window (CTRL G in debugger)
    Debug.Print oData.Count
    For i = 0 To oData.Count - 1
      Debug.Print oData(i)
    Next i
    
    'Sort array
    oData.Sort
    'Put the values in the ComboBox
    For i = 0 To oData.Count - 1
      cboCab3.AddItem oData(i)
    Next i
    'Clear object pointers
    Set myRange = Nothing
    Set Ws = Nothing
    Set oData = Nothing
End Sub
Private Sub cboCab3_DropButt*******()
    
    Dim Ws As Worksheet
    Dim iLastRowUsed As Long
    Dim sRowSource As String
  
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    iLastRowUsed = Ws.Columns("H").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'H'
    sRowSource = "'LBaseCabinets'!H2:H" & iLastRowUsed
        
    'Populate the ComboBoxes
    cboCab3.RowSource = sRowSource
        
    'Clear object pointers
    Set Ws = Nothing
End Sub
Private Sub cboCab4_Change()
    Dim Ws As Worksheet
    Dim myRange As Range
    Dim oData As Object
    Dim R As Range
    
    Dim i As Long
    Dim iLastRowUsed As Long
    Dim sRange As String
    Dim sValue As String
  
    Set oData = CreateObject("System.Collections.ArrayList")
    
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    cboCab4.RowSource = ""
    iLastRowUsed = Ws.Columns("V").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'V'
    sRange = "V2:V" & iLastRowUsed
    Set myRange = Ws.Range(sRange)
    'load array
    For Each R In myRange
      sValue = CStr(Trim(R.Value))      'Remove leading/trailing spaces and make sure the data is a string value
      oData.Add sValue
    Next
    
    'Look at the data during Software Development before sorting in the Immediate Window (CTRL G in debugger)
    Debug.Print oData.Count
    For i = 0 To oData.Count - 1
      Debug.Print oData(i)
    Next i
    
    'Sort array
    oData.Sort
    'Put the values in the ComboBox
    For i = 0 To oData.Count - 1
      cboCab4.AddItem oData(i)
    Next i
    'Clear object pointers
    Set myRange = Nothing
    Set Ws = Nothing
    Set oData = Nothing
End Sub
Private Sub cboCab4_DropButt*******()
    
    Dim Ws As Worksheet
    Dim iLastRowUsed As Long
    Dim sRowSource As String
  
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    iLastRowUsed = Ws.Columns("V").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'V'
    sRowSource = "'LBaseCabinets'!V2:V" & iLastRowUsed
        
    'Populate the ComboBoxes
    cboCab4.RowSource = sRowSource
        
    'Clear object pointers
    Set Ws = Nothing
End Sub
Private Sub cboCab5_Change()
    Dim Ws As Worksheet
    Dim myRange As Range
    Dim oData As Object
    Dim R As Range
    Dim i As Long
    Dim iLastRowUsed As Long
    Dim sRange As String
    Dim sValue As String
  
    Set oData = CreateObject("System.Collections.ArrayList")
    
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    cboCab5.RowSource = ""
    iLastRowUsed = Ws.Columns("AC").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'AC'
    sRange = "AC2:AC" & iLastRowUsed
    Set myRange = Ws.Range(sRange)
    'load array
    For Each R In myRange
      sValue = CStr(Trim(R.Value))      'Remove leading/trailing spaces and make sure the data is a string value
      oData.Add sValue
    Next
    
    'Look at the data during Software Development before sorting in the Immediate Window (CTRL G in debugger)
    Debug.Print oData.Count
    For i = 0 To oData.Count - 1
      Debug.Print oData(i)
    Next i
    
    'Sort array
    oData.Sort
    'Put the values in the ComboBox
    For i = 0 To oData.Count - 1
      cboCab5.AddItem oData(i)
    Next i
    'Clear object pointers
    Set myRange = Nothing
    Set Ws = Nothing
    Set oData = Nothing
End Sub
Private Sub cboCab5_DropButt*******()
    
    Dim Ws As Worksheet
    Dim iLastRowUsed As Long
    Dim sRowSource As String
  
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    iLastRowUsed = Ws.Columns("AC").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'AC'
    sRowSource = "'LBaseCabinets'!AC2:AC" & iLastRowUsed
        
    'Populate the ComboBoxes
    cboCab5.RowSource = sRowSource
        
    'Clear object pointers
    Set Ws = Nothing
End Sub
Private Sub cboCab6_Change()
    Dim Ws As Worksheet
    Dim myRange As Range
    Dim oData As Object
    Dim R As Range
    Dim i As Long
    Dim iLastRowUsed As Long
    Dim sRange As String
    Dim sValue As String
  
    Set oData = CreateObject("System.Collections.ArrayList")
    
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    cboCab6.RowSource = ""
    iLastRowUsed = Ws.Columns("AJ").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'AJ'
    sRange = "AJ2:AJ" & iLastRowUsed
    Set myRange = Ws.Range(sRange)
    'load array
    For Each R In myRange
      sValue = CStr(Trim(R.Value))      'Remove leading/trailing spaces and make sure the data is a string value
      oData.Add sValue
    Next
    
    'Look at the data during Software Development before sorting in the Immediate Window (CTRL G in debugger)
    Debug.Print oData.Count
    For i = 0 To oData.Count - 1
      Debug.Print oData(i)
    Next i
    
    'Sort array
    oData.Sort
    'Put the values in the ComboBox
    For i = 0 To oData.Count - 1
      cboCab6.AddItem oData(i)
    Next i
    'Clear object pointers
    Set myRange = Nothing
    Set Ws = Nothing
    Set oData = Nothing
End Sub
Private Sub cboCab6_DropButt*******()
    
    Dim Ws As Worksheet
    Dim iLastRowUsed As Long
    Dim sRowSource As String
  
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    iLastRowUsed = Ws.Columns("AJ").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'AJ'
    sRowSource = "'LBaseCabinets'!AJ2:AJ" & iLastRowUsed
        
    'Populate the ComboBoxes
    cboCab6.RowSource = sRowSource
        
    'Clear object pointers
    Set Ws = Nothing
End Sub
Private Sub cboCab7_Change()
    Dim Ws As Worksheet
    Dim myRange As Range
    Dim oData As Object
    Dim R As Range
    Dim i As Long
    Dim iLastRowUsed As Long
    Dim sRange As String
    Dim sValue As String
  
    Set oData = CreateObject("System.Collections.ArrayList")
    
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    cboCab7.RowSource = ""
    iLastRowUsed = Ws.Columns("AQ").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'AQ'
    sRange = "AQ2:AQ" & iLastRowUsed
    Set myRange = Ws.Range(sRange)
    'load array
    For Each R In myRange
      sValue = CStr(Trim(R.Value))      'Remove leading/trailing spaces and make sure the data is a string value
      oData.Add sValue
    Next
    
    'Look at the data during Software Development before sorting in the Immediate Window (CTRL G in debugger)
    Debug.Print oData.Count
    For i = 0 To oData.Count - 1
      Debug.Print oData(i)
    Next i
    
    'Sort array
    oData.Sort
    'Put the values in the ComboBox
    For i = 0 To oData.Count - 1
      cboCab7.AddItem oData(i)
    Next i
    'Clear object pointers
    Set myRange = Nothing
    Set Ws = Nothing
    Set oData = Nothing
End Sub
Private Sub cboCab7_DropButt*******()
    
    Dim Ws As Worksheet
    Dim iLastRowUsed As Long
    Dim sRowSource As String
  
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    iLastRowUsed = Ws.Columns("AQ").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'AQ'
    sRowSource = "'LBaseCabinets'!AQ2:AQ" & iLastRowUsed
        
    'Populate the ComboBoxes
    cboCab7.RowSource = sRowSource
        
    'Clear object pointers
    Set Ws = Nothing
End Sub
Private Sub cboCab8_Change()
    Dim Ws As Worksheet
    Dim myRange As Range
    Dim oData As Object
    Dim R As Range
    Dim i As Long
    Dim iLastRowUsed As Long
    Dim sRange As String
    Dim sValue As String
  
    Set oData = CreateObject("System.Collections.ArrayList")
    
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    cboCab8.RowSource = ""
    iLastRowUsed = Ws.Columns("AX").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'AX'
    sRange = "AX2:AX" & iLastRowUsed
    Set myRange = Ws.Range(sRange)
    'load array
    For Each R In myRange
      sValue = CStr(Trim(R.Value))      'Remove leading/trailing spaces and make sure the data is a string value
      oData.Add sValue
    Next
    
    'Look at the data during Software Development before sorting in the Immediate Window (CTRL G in debugger)
    Debug.Print oData.Count
    For i = 0 To oData.Count - 1
      Debug.Print oData(i)
    Next i
    
    'Sort array
    oData.Sort
    'Put the values in the ComboBox
    For i = 0 To oData.Count - 1
      cboCab8.AddItem oData(i)
    Next i
    'Clear object pointers
    Set myRange = Nothing
    Set Ws = Nothing
    Set oData = Nothing
End Sub
Private Sub cboCab8_DropButt*******()
    
    Dim Ws As Worksheet
    Dim iLastRowUsed As Long
    Dim sRowSource As String
  
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    iLastRowUsed = Ws.Columns("AX").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'AX'
    sRowSource = "'LBaseCabinets'!AX2:AX" & iLastRowUsed
        
    'Populate the ComboBoxes
    cboCab8.RowSource = sRowSource
        
    'Clear object pointers
    Set Ws = Nothing
End Sub
Private Sub cboCab9_Change()
    Dim Ws As Worksheet
    Dim myRange As Range
    Dim oData As Object
    Dim R As Range
    Dim i As Long
    Dim iLastRowUsed As Long
    Dim sRange As String
    Dim sValue As String
  
    Set oData = CreateObject("System.Collections.ArrayList")
    
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    cboCab9.RowSource = ""
    iLastRowUsed = Ws.Columns("BE").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'BE'
    sRange = "BE2:BE" & iLastRowUsed
    Set myRange = Ws.Range(sRange)
    'load array
    For Each R In myRange
      sValue = CStr(Trim(R.Value))      'Remove leading/trailing spaces and make sure the data is a string value
      oData.Add sValue
    Next
    
    'Look at the data during Software Development before sorting in the Immediate Window (CTRL G in debugger)
    Debug.Print oData.Count
    For i = 0 To oData.Count - 1
      Debug.Print oData(i)
    Next i
    
    'Sort array
    oData.Sort
    'Put the values in the ComboBox
    For i = 0 To oData.Count - 1
      cboCab9.AddItem oData(i)
    Next i
    'Clear object pointers
    Set myRange = Nothing
    Set Ws = Nothing
    Set oData = Nothing
End Sub
Private Sub cboCab9_DropButt*******()
    
    Dim Ws As Worksheet
    Dim iLastRowUsed As Long
    Dim sRowSource As String
  
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    iLastRowUsed = Ws.Columns("BE").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'BE'
    sRowSource = "'LBaseCabinets'!BE2:BE" & iLastRowUsed
        
    'Populate the ComboBoxes
    cboCab9.RowSource = sRowSource
        
    'Clear object pointers
    Set Ws = Nothing
End Sub
Private Sub cboCab10_Change()
    Dim Ws As Worksheet
    Dim myRange As Range
    Dim oData As Object
    Dim R As Range
    Dim i As Long
    Dim iLastRowUsed As Long
    Dim sRange As String
    Dim sValue As String
  
    Set oData = CreateObject("System.Collections.ArrayList")
    
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    cboCab10.RowSource = ""
    iLastRowUsed = Ws.Columns("BL").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'BL'
    sRange = "BL2:BL" & iLastRowUsed
    Set myRange = Ws.Range(sRange)
    'load array
    For Each R In myRange
      sValue = CStr(Trim(R.Value))      'Remove leading/trailing spaces and make sure the data is a string value
      oData.Add sValue
    Next
    
    'Look at the data during Software Development before sorting in the Immediate Window (CTRL G in debugger)
    Debug.Print oData.Count
    For i = 0 To oData.Count - 1
      Debug.Print oData(i)
    Next i
    
    'Sort array
    oData.Sort
    'Put the values in the ComboBox
    For i = 0 To oData.Count - 1
      cboCab10.AddItem oData(i)
    Next i
    'Clear object pointers
    Set myRange = Nothing
    Set Ws = Nothing
    Set oData = Nothing
End Sub
Private Sub cboCab10_DropButt*******()
    
    Dim Ws As Worksheet
    Dim iLastRowUsed As Long
    Dim sRowSource As String
  
    'Create the Worksheet Object
    Set Ws = ThisWorkbook.Worksheets("LBaseCabinets")
    
    iLastRowUsed = Ws.Columns("BL").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If iLastRowUsed < 2 Then
      iLastRowUsed = 2
    End If
    
    'Get the Range that contains data in Column 'BL'
    sRowSource = "'LBaseCabinets'!BL2:BL" & iLastRowUsed
        
    'Populate the ComboBoxes
    cboCab10.RowSource = sRowSource
        
    'Clear object pointers
    Set Ws = Nothing
End Sub
</create>
 
Last edited by a moderator:
Sort by date Sort by votes
Well here is how you can load values from column A into Cab1

You can do the other 9

Code: 
Private Sub CommandButton1_Click()
'Modified  2/12/2019  8:48:45 PM  EST
Dim Lastrow As Long
Lastrow = Sheets("LDataBaseCabinets").Cells(Rows.Count, "A").End(xlUp).Row
Cab1.List = Sheets("LDataBaseCabinets").Cells(1, 1).Resize(Lastrow).Value
End Sub
 
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
That worked out well. I changed the worksheet as well as the cell row and column. I did remove some of the enabled true and false redundant code. I was wondering if there is a way to streamline some of the code for the sections LoadDataList, CboSearch_After Save and CboSearch_DropButt*******?
 
Upvote 0
Well there is just way too much code here for me to help with.
I never think it's a good to just get pieces of code from here and there and try to putt in all together and hope it works.
Like I showed you how you can clear all those controls with just a loop.
But you never mentioned if this worked or not.
And all those controls loose all their values when you close the Userform.
So not sure why you think they all need to be cleared unless you plan to keep running different scripts using the same controls without closing the Userform.
I do not believe you ever explained what the total object of this project is.
But maybe you did and I forgot.






You said:
Can you shorten these parts:
LoadDataList, CboSearch_After Save and CboSearch_DropButt*******?

Post that part of the code here:

I'm not sure where those part's all.

And why are you using Functions in the middle of your subs?


And lets just do one part at a time.

Post one of those here and let me see

And maybe explain in words what you want this part of code to do.
​
 
Upvote 0
thank you

I did use the clear loop and it works well.

As far as clearing after save and delete it just saves me from having to clear the form it I want to revise another model

The scope of the project is to allow the user to revise individual cabinets or add cabinets to a particular model

As for the code, It works fine, but as you stated its a lot of code. I eliminated one section and it still works fine.
The other two creates an array list and the second fills the search cbo and the cboCab1 thru ten with data.

Private Function LoadDataList() As Boolean
Dim Ws As Worksheet
Dim Rng As Range
Dim C As Range
Dim Data As Object
Dim k As Variant

Set Data = CreateObject("System.Collections.ArrayList")

'Get Records definition
Set Ws = ThisWorkbook.Worksheets("LDataBaseCabinets")
Set Rng = Ws.Range("A:A")

'load array
For Each C In Rng.Cells
If C.Value <> "" Then
Data.Add C.Value
End If
Next

'Sort array
Data.Sort

For Each k In Data

cboSearch.AddItem k

Next

Set Rng = Nothing
Set Ws = Nothing
Set Data = Nothing

End Function

Private Sub cboSearch_DropButt*******()

'Every change of the dropdown get the value
Dim findString As String
Dim iRow As Integer
Dim Rng As Range
Dim Ws As Worksheet
Set Ws = Worksheets("LDataBaseCabinets")
findString = cboSearch.Text
lblRowID.Caption = ""
If findString <> "" Then
With Sheets("LDataBaseCabinets").Range("A:A")
Set Rng = .Find(What:=findString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'store found row in lblRowID, a hidden field on form
lblRowID.Caption = Rng.Row
End If
End With
End If
If lblRowID.Caption <> "" Then
'load values on form
iRow = Val(lblRowID.Caption)

Me.tbxNumber.Value = Ws.Cells(iRow, 1).Value
Me.tbxStyle.Value = Ws.Cells(iRow, 2).Value
Me.cboCab1.Value = Ws.Cells(iRow, 3).Value
Me.cboCab2.Value = Ws.Cells(iRow, 4).Value
Me.cboCab3.Value = Ws.Cells(iRow, 5).Value
Me.cboCab4.Value = Ws.Cells(iRow, 6).Value
Me.cboCab5.Value = Ws.Cells(iRow, 7).Value
Me.cboCab6.Value = Ws.Cells(iRow, 8).Value
Me.cboCab7.Value = Ws.Cells(iRow, 9).Value
Me.cboCab8.Value = Ws.Cells(iRow, 10).Value
Me.cboCab9.Value = Ws.Cells(iRow, 11).Value
Me.cboCab10.Value = Ws.Cells(iRow, 12).Value

cmdUpdate.Enabled = True
cmdClear.Enabled = True
cmdSave.Enabled = False
cmdDelete.Enabled = True

End If
End Sub
 
Upvote 0
Actually I do that particular code sometimes gives me an error code failed to compare two elements

'Sort array
Data.Sort
 
Upvote 0
This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Combine input box (multiple criteria)
Replies
4
Views
149
gomes123
G
V
  • Solved
Need VBA to split data into multiple sheets paste formulas, formatting AND data validation
Replies
2
Views
123
vanessavalentino83
V
WERNER SLABBERT
  • Question Question
Run-time error 70 after code changed
Replies
3
Views
118
RoryA
RoryA
T
  • Solved
Populate Worksheet Rows Based on Userform Checkbox selection
2
Replies
11
Views
179
TellM1955
T
H
  • Solved
Splitting Data into Workbooks - EDIT HELP
Replies
1
Views
291
horrellbt01
H

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top