Search code examples
excelvbalistboxuserform

populate VBA list box from row source and update multiple rows


i am trying to populate VBA userform listbox with below code. It works if i select range from A to F column. however if i change A to L, it gives me an error.

can you help me to correct below code?

    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("part bump")

    Dim Last_Row As Long
    Dim r, c As Range

    Last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

    With UserForm3
       
        .lstDatabase.ColumnCount = 11
        .lstDatabase.ColumnHeads = True
        .lstDatabase.ColumnWidths = "20,40,40,40,2,60,60,60,60,300,60"
        
        Set r = sh.Range("A4:F" & Last_Row)
     
        i = 0
        For Each d In r.Rows
            j = 0
            For Each c In d.Cells
                UserForm3.lstDatabase.AddItem
     
                UserForm3.lstDatabase.List(i, j) = c.Value
                j = j + 1
     
            Next c
            i = i + 1
        Next d
     
        If Last_Row = 1 Then
            UserForm3.lstDatabase.RowSource = "part bump!A4:F4"
        
        End If
        
    End With

Below code use to update multiple selected rows under userform. it only updates 1st selected row not all selected rows.

    Private Sub cmdaction_Click()
    Dim t, t1 As String
  Dim vrech As Range, lColumn As Range
  Dim sh As Worksheet
  Dim i As Long
  Dim selItem As String
  
  Set sh = ThisWorkbook.Sheets("part bump")
  Set lColumn = sh.Range("H1:AZA1").Find(Val(txtchangenumber.Value), , xlValues, xlWhole)
  If lColumn Is Nothing Then
    MsgBox "Column not found"
    Exit Sub
  End If
  
  With UserForm3.lstDatabase
    For i = 0 To UserForm3.lstDatabase.ListCount - 1
    
      If UserForm3.lstDatabase.Selected(i) = True Then
        Set vrech = sh.Range("E3:E250").Find(.Column(4, i), , xlValues, xlWhole)
        If Not vrech Is Nothing Then
          Select Case cmbaction.Value
            Case "RP"
              t = Chr(Asc(Mid(.List(i, 4), 2, 1)) + 1)
              'Me.lstDatabase.Row (0), Column(4) = "ABA"
              t1 = Mid(.List(i, 4), 1, 1) & t & Mid(.List(i, 4), 3, 1)
              Intersect(vrech.EntireRow, lColumn.EntireColumn) = t1
          Case "RV"
            Intersect(vrech.EntireRow, lColumn.EntireColumn) = .List(i, 4)
          Case "DP"
            Intersect(vrech.EntireRow, lColumn.EntireColumn) = "Deleted"
            vrech.EntireRow.Font.Strikethrough = True
          End Select
        End If
      End If
      
    Next i
  End With
End Sub

Solution

  • Populate Listbox

    It's not clear for me whether you want to assign range data

    • a) via the listbox'es .RowSource property (showing headers) or
    • b) via the listbox'es .List property (allowing no headers)

    I demonstrate both approaches modifying your original code.

    Furthermore I suggest to move your code into the form's own code module - the UserForm_Initialize handler would be a good place for this. C.f.

    Version a)

    Note that you have to include a blank delimited sheet name (part bump) within "'", e.g. via

    .RowSource = "'part bump'!A4:L17"
    

    or

    .RowSource = "'" & sh.Name & "'!" & rng.Address 
    
    Private Sub UserForm_Initialize()
        
        Dim sh As Worksheet
        Set sh = ThisWorkbook.Worksheets("part bump")
        
        Const HeaderRow As Long = 3
        Dim LastRow     As Long
        LastRow = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
        If LastRow = HeaderRow Then LastRow = HeaderRow + 1 ' provide for empty data
        
        Dim rng As Range
        Set rng = sh.Range("A" & HeaderRow + 1 & ":L" & LastRow)
        Debug.Print rng.Address
        
        With lstDatabase
            .ColumnCount = 11
            .ColumnWidths = "20;40;40;40;2;60;60;60;60;300;60"
            
            'a) Row Source plus headers
            .ColumnHeads = True
            .RowSource = "'" & sh.Name & "'!" & rng.Address   ' << don't forget "'" around sheet name!
    
        End With
        
    End Sub
    

    Version b)

    "It works if i select range from A to F column. however if i change A to L, it give me an error."

    Adding data via the .AddItem method has a not documented limitation of 10 columns only
    (these are provided automatically as empty array items of the .List property). Therefore it's not possible to reference a (zero-based) column index of 10 or more as it doesn't exist.

    You can shorten your code and overcome this limitation by assigning an entire data field array to the listbox'es .List property. c.f.: Populate listbox with multiple columns

    Private Sub UserForm_Initialize()
        
        Dim sh As Worksheet
        Set sh = ThisWorkbook.Worksheets("part bump")
        
        Const HeaderRow As Long = 3
        Dim LastRow     As Long
        LastRow = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
        If LastRow = HeaderRow Then LastRow = HeaderRow + 1 ' provide for empty data
        
        Dim rng As Range
        Set rng = sh.Range("A" & HeaderRow + 1 & ":L" & LastRow)
        Debug.Print rng.Address
        
        With lstDatabase
            .ColumnCount = 11
            .ColumnWidths = "20;40;40;40;2;60;60;60;60;300;60"
            
            'b) alternatively via array assignment (without headers!)
            '   allows to overcome 10 column limitation of .AddItem
            .ColumnHeads = False
    
            .List = rng.Value   ' << assign data field array as a whole to .List
        End With
        
    End Sub
    
    

    Further hint

    Your declaration in OP (Dim r, c As Range) intends to declare a Range data type to both variables, but it fails as VBA assumes Variant for r if not declare expressly (Dim r as Range, c As Range).