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
Populate Listbox
It's not clear for me whether you want to assign range data
.RowSource
property (showing headers) or.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
).