Want to be able to transfer/insert data from a listbox to a specific row in a table on sheet

[Paulo H]

Hi

I have created a listbox and can transfer data from it to a table ion a sheet but it will only populate the last row of the table. Sometimes it may be require do insert/transfer the data to a row mid table ie if something had been forgotten and needed to be added later. I can drag the the row up but I would prefer to add at the specific row. Can't fid a way to do it.

eg Table is populated to row 10. I then want to transfer an item from the list box and insert it in row 5, but this code only allows it to go to row 11

here is my code


Private Sub Transfer_Click()
ActiveSheet.Unprotect Password:="123"
Dim wrksht As Worksheet
Dim objListObj As ListObject


Dim i As Long
Dim listObj As ListObject
Set listObj = Sheets("Quote Form").ListObjects("Table1")
listObj.ListRows.Add , 1

listObj.DataBodyRange(listObj.ListRows.Count, 1) = ListBox1.List(ListBox1.ListIndex)


For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = True And Me.ListBox1.List(i, 1) <> "" Then
'Sheet1.Range("A12345").End(xlUp).Offset(1, 0) = Me.ListBox1.List(i, 0)
Sheet1.Range("A12345").End(xlUp).Offset(0, 3) = Me.ListBox1.List(i, 1)
Sheet1.Range("A12345").End(xlUp).Offset(0, 4) = Me.ListBox1.List(i, 3)
Sheet1.Range("A12345").End(xlUp).Offset(0, 2) = Me.ListBox1.List(i, 2)
Sheet1.Range("A12345").End(xlUp).Offset(0, 6) = Me.ListBox1.List(i, 4)
For x = 1 To 4
'Sheet1.Range("A123").End(xlUp).Offset(0, 1) = Me.ListBox1.List(i, x)
'Sheet1.Range("Table1").End(xlUp).Offset(3, 3) = Me.ListBox1.List(i, 3)

Next x

End If
Next i

End Sub


Many thanks

 

[DanteAmor]

I then want to transfer an item from the list box and insert it in row 5

I didn't quite understand what you are going to transfer from the listbox to the table.
But with the following example you transfer the selected record in the listbox to row 5 of the table.

Private Sub Transfer_Click()
  Dim i As Long, listObj As ListObject
  
  Set listObj = Sheets("Quote Form").ListObjects("Table1")
  With ListBox1
    If .ListIndex > -1 Then
      listObj.ListRows.Add (5)
      listObj.DataBodyRange(5, 1) = .List(.ListIndex, 0)
      listObj.DataBodyRange(5, 2) = .List(.ListIndex, 1)
      listObj.DataBodyRange(5, 3) = .List(.ListIndex, 2)
      listObj.DataBodyRange(5, 4) = .List(.ListIndex, 3)
      listObj.DataBodyRange(5, 5) = .List(.ListIndex, 4)
    End If
  End With
End Sub

 

[Paulo H]

Hi

What I really want to do is to insert at the row I click on therefore onetime it may be row 5 or 8 or6 etc so would that be the active row?

Thanks for your help

 

[DanteAmor]

What I really want to do is to insert at the row I click on therefore onetime it may be row 5 or 8 or6 etc so would that be the active row?

Check if the following works for you

      listObj.ListRows.Add (ActiveCell.Row)
      listObj.DataBodyRange(ActiveCell.Row, 1) = Me.ListBox1.List(i, 0)

 

[Paulo H]

listObj.ListRows.Add (ActiveCell.Row) listObj.DataBodyRange(ActiveCell.Row, 1) = Me.ListBox1.List(i, 0)

Hi I am affraid this didn't work comes up with script out of range

 

[DanteAmor]

Hi I am affraid this didn't work comes up with script out of range

You can put your complete code to see how you are using it.

 

[Paulo H]

this is what is working at the moment but I am not sure were to insert the code you sent. BTW the code to add at row 5 works great so if that could be altered for active row?

Private Sub Transfer_Click()
ActiveSheet.Unprotect Password:="123"
Dim wrksht As Worksheet
Dim objListObj As ListObject


Dim i As Long
Dim listObj As ListObject
Set listObj = Sheets("Quote Form").ListObjects("Table1")
listObj.ListRows.Add , 1

listObj.DataBodyRange(listObj.ListRows.Count, 1) = ListBox1.List(ListBox1.ListIndex)


For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = True And Me.ListBox1.List(i, 1) <> "" Then
'Sheet1.Range("A12345").End(xlUp).Offset(1, 0) = Me.ListBox1.List(i, 0)
Sheet1.Range("A12345").End(xlUp).Offset(0, 3) = Me.ListBox1.List(i, 1)
Sheet1.Range("A12345").End(xlUp).Offset(0, 4) = Me.ListBox1.List(i, 3)
Sheet1.Range("A12345").End(xlUp).Offset(0, 2) = Me.ListBox1.List(i, 2)
Sheet1.Range("A12345").End(xlUp).Offset(0, 6) = Me.ListBox1.List(i, 4)
For x = 1 To 4
'Sheet1.Range("A123").End(xlUp).Offset(0, 1) = Me.ListBox1.List(i, x)
'Sheet1.Range("Table1").End(xlUp).Offset(3, 3) = Me.ListBox1.List(i, 3)

Next x

End If
Next i

End Sub

 

[DanteAmor]

For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = True And Me.ListBox1.List(i, 1) <> "" Then

In your listbox can you select multiple records?
Or are you just going to migrate one record?

 

[Paulo H]

Just one record migrates

thank you

 

[DanteAmor]

Replace all your code for this:

Private Sub Transfer_Click()
  Dim listObj As ListObject
  
  ActiveSheet.Unprotect Password:="123"
  Set listObj = Sheets("Quote Form").ListObjects("Table1")
  listObj.ListRows.Add (ActiveCell.Row)
  With ListBox1
    listObj.DataBodyRange(ActiveCell.Row, 1) = .List(.ListIndex, 0)
    listObj.DataBodyRange(ActiveCell.Row, 3) = .List(.ListIndex, 1)
    listObj.DataBodyRange(ActiveCell.Row, 4) = .List(.ListIndex, 3)
    listObj.DataBodyRange(ActiveCell.Row, 2) = .List(.ListIndex, 2)
    listObj.DataBodyRange(ActiveCell.Row, 6) = .List(.ListIndex, 4)
  End With
End Sub