Copy from listbox to last row on sheet and delete from original

[chipsworld]

Hi all...

Have one I just can't figure out...

Have a listbox in a form that is used to copy multiselections to a different sheet than the one with source data.

I am trying to figure out how to copy to last row on new sheet and how to delete from original sheet.

Copying over data works great, but writes over existing data on second use...want to just put at lastrow + 1, and I have no idea how to delete the data form the source sheet...

Here is the code so far...

Source sheet is "UC Details"

Moving to "Completed UCs"

Private Sub cmdremove_Click()
Dim lItem As Long, lRows As Long, lCols As Long
Dim bSelected As Boolean
Dim lColLoop As Long, lTransferRow As Long
Dim ws As Worksheet
Dim lstrw As Double
Dim rw As Double

Set ws = Sheets("Completed UCs")

With ws
lstrw = .Range("A" & Rows.Count).End(xlUp).Row
        rw = lstrw + 1
End With

 'Pass row & column count to variables
 'Less 1 as "Count" starts at zero
 lRows = lstmain.ListCount - 1
 lCols = lstmain.ColumnCount - 1
 
    'Ensure they have at least 1 row selected
    For lItem = 0 To lRows
        'At least 1 row selected
        If lstmain.Selected(lItem) = True Then
            'Boolean flag
            bSelected = True
            'Exit for loop
            Exit For
        End If
    Next
     
    'At least 1 row selected
    If bSelected = True Then
        With Sheets("Completed UCs").Range("A2", Sheets("Completed UCs").Cells(lRows + 1, 4 + lCols)) 'Transfer to range
            
            For lItem = 0 To lRows
                If lstmain.Selected(lItem) = True Then 'Row selected
                  'Increment variable for row transfer range
                  lTransferRow = lTransferRow + 1
                    'Loop through columns of selected row
                    For lColLoop = 0 To lCols
                       'Transfer selected row to relevant row of transfer range
                       .Cells(lTransferRow, lColLoop + 1) = lstmain.List(lItem, lColLoop)
                        'Uncheck selected row
                        lstmain.Selected(lItem) = False
                    Next lColLoop
                End If
            Next
        End With

    Else
         MsgBox "There are no line items selected!", vbCritical
    End If

End Sub

 

[DanteAmor]

In order to know for each item selected from the listbox its corresponding record in the sheet, we need to know how you loaded the records of the sheet in your listbox. Put all your code here.

Another question, are you loading all the records of the sheet in the listbox? Or do you have some kind of filter and only load the records that meet the condition in the listbox?

 

[chipsworld]

Dante,
Here you go... I load ALL of the records into the listbox upon opening the userform.

I want to do a multi select in the listbox, and upon clicking the "GO" button, remove them from the original sheet and place them in the "lastrow" of a new sheet. I can then refresh the

Hope this helps...

Private Sub UserForm_Activate()

frmcomp.Height = 440
frmcomp.Width = 417

Dim ws As Worksheet
Dim rng As Range
Dim Myarray
Dim vData As Variant
Dim vTemp As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim SortByCol As Long

SortByCol = 0 'Select column to sort main list by when displayed in form

Set ws = ThisWorkbook.Worksheets("UC Details") 'set sheetname

' Set range here
Set rng = ws.Range("A2:I" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row) 'selection list


    With Me.lstmain
        .Clear
        .ColumnHeads = False
        .ColumnCount = rng.Columns.Count
   
        'create a one based 2-dim datafield array
         Myarray = rng
   
        'fill listbox with array values
        .List = Myarray
   
        'Set the widths of the column here
        .ColumnWidths = "100;100;100;0;0;0;0;0;0"
        .TopIndex = 0
    End With
     
    With Me.lstmain
            vData = .List
            For i = LBound(vData, 1) To UBound(vData, 1) - 1
                For j = i + 1 To UBound(vData, 1)
                    If vData(i, SortByCol) > vData(j, SortByCol) Then
                        For k = LBound(vData, 2) To UBound(vData, 2)
                            vTemp = vData(i, k)
                            vData(i, k) = vData(j, k)
                            vData(j, k) = vTemp
                        Next k
                    End If
                Next j
            Next i
            .List = vData
        End With
End Sub

 

[DanteAmor]

You are sorting the data in the listbox by column A. So record 1 of the listbox does not necessarily correspond to record 1 of the sheet.
Is the data in column A unique or are there duplicates?

 

[chipsworld]

Column A is unique..."Should" never repeat.

Also...Column is a 9 digit numeric value (if that helps). Everything else is text

Thanks Again

 

[DanteAmor]

Try this:

Private Sub cmdremove_Click()
  Dim ws As Worksheet
  Dim i As Long, j As Long, lr As Long
  Dim bSelected As Boolean
  Dim rng As Range, f As Range
 
  Set ws = Sheets("Completed UCs")
  lr = ws.Range("A" & Rows.Count).End(3).Row + 1      'lastrow
  With lstmain
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then                     'Item selected
        For j = 0 To .ColumnCount - 1
          ws.Cells(lr, j + 1) = .List(i, j)           'Transfer selected row
        Next j
                                                      'Find record to delete
        Set f = Sheets("UC Details").Range("A:A").Find(.List(i, 0), , xlValues, xlWhole, , , False)
        If Not f Is Nothing Then
          If rng Is Nothing Then Set rng = f Else Set rng = Union(rng, f)
        End If
       
        .Selected(i) = False                          'Uncheck selected row
        lr = lr + 1
        bSelected = True
      End If
    Next
  End With
 
  If bSelected = False Then
    MsgBox "There are no line items selected!", vbCritical
  Else
    If Not rng Is Nothing Then rng.EntireRow.Delete   'delete records
    UserForm_Activate
    MsgBox "Records transferred"
  End If
End Sub

 

[chipsworld]

Dante,
Thank you...never thought of doing it that way.

As always, you have saved the day!

 

[DanteAmor]

Im glad to help you. Thanks for the feedback.