Listbox move to dormant

[Sharid]

I have a userform called ProductList, with 1 ListBox and a Dormant Button, when the form opens it populates from data on sheet5 (Products) I can't work out a code so when the user selects a item in the listbox and clicks on the dormant button. It will copy and pastes that information to sheet6 (Dormant) and remove that data from the listbox and Sheet5(Products),

e.g
Userform ProductList opens and is populated from Sheet5 (Products)

User select data in ListBox1

User clicks on the Dormant button

The item that was selected in Listbox1 is now copied and pasted into a Sheet6 (Dormant) in next blank row

THEN

The selected data from Listbox1 is removed from listbox1 and Sheet5 (Products) and any blank rows removed Sheet is auto saved, So the next time the user opens the ProductList userform and Listbox1 is populated from Sheet5 (Products) the removed data is no longer showing.

The data is on sheet5 (Products) Column A to R it will need to copy and past into Sheet6 (Dormant) Column A to R next blank row.

 

[MickG]

Paste this code into sheet5 Userform module for results on sheet 6.

Option Explicit
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
Private [COLOR="Navy"]Sub[/COLOR] UserForm_Initialize()
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] ListBox1
    .List = Rng.Value
    .ColumnCount = 18
    '[COLOR="Green"][B].ColumnWidths = "100,100,100,100"[/B][/COLOR] 'Use/Alter as necessary
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Private [COLOR="Navy"]Sub[/COLOR] ListBox1_Click()
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] RayAc [COLOR="Navy"]As[/COLOR] Variant
Rng.Interior.ColorIndex = 6
[COLOR="Navy"]With[/COLOR] Sheets("Sheet6")
    [COLOR="Navy"]If[/COLOR] .Cells(1, 1) = "" [COLOR="Navy"]Then[/COLOR]
        Lst = 1
    [COLOR="Navy"]Else[/COLOR]
        Lst = .Cells(Rows.Count, 1).End(3).Offset(1).Row
    [COLOR="Navy"]End[/COLOR] If

[COLOR="Navy"]With[/COLOR] ListBox1
    [COLOR="Navy"]With[/COLOR] Rng.Cells(.ListIndex + 1)
        RayAc = Range(.Address).Resize(, 18)
        Sheets("Sheet6").Cells(Lst, 1).Resize(, 18) = RayAc
        Range(.Address).EntireRow.Delete
   [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] With
Unload Me
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Sharid]

Thanks Mick I will give your code a shot, I had just done this one and it all most worked

Ok I have put together this code, which copies to dormant and deletes the data in the listbox and the listbox data source sheet, which is Sheet5 (Products)

The code works fine for the most part.

Copy and paste is fine, so the first bit of the code is ok.

The problem is in the second bit.

If i move 1 item at a time to dormant not including the last item in the list box everything is fine,

If i move only the last item to dormant, it deletes everything in the list box and sheet5 (product) and has only copied and pasted the last item to dormant.

can someone have alook at the last bit, THANKS

Private Sub CommandButton7_Click()
'Copy to dormant
Dim i As Long, j As Long
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) Then
            j = j + 1
             Worksheets("Products").Range("A" & i + 2).Resize(1, 6).Copy  Worksheets("Dormant").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next i
    MsgBox j & " Data has been moved to dormant"
    
 'REMOVE SELECTION
    With ListBox1
      For i = .ListCount - 1 To 0 Step -1
       If .Selected(i) Then
           .RemoveItem i
           Sheets("Products").Rows(i + 2).EntireRow.Delete
        End If
      Next i
      End With
End Sub

 

[MickG]

Perhaps just this:-

Private Sub CommandButton1_Click()
Dim i As Long, j As Long
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) Then
            j = j + 1
             With Worksheets("Products").Range("A" & i + 1)
                .Resize(, 6).Copy Worksheets("Dormant").Range("A" & Rows.Count).End(xlUp).Offset(1)
                .EntireRow.Delete
            End With
            Me.ListBox1.RemoveItem i
        End If
    Next i
    MsgBox j & " Data has been moved to dormant"
End Sub

 

[Sharid]

MickG

This works far better, there is only one little problem. If I have 10 rows and on the list box i click on row 10 to move to dormant, It shows that it has removed row 10 IN THE LISTBOX however on the Work Sheet it has actually removed ROW 9. So row 6 will remove row 5 on the worksheet and so on.

I'm not sure if its your code or conflicting with another one of my codes. Can you double check yours before i post the rest of my codes,

 

[Sharid]

Its ok I have fixed the problems, its not your code, it was conflicting with a line of code i had in my UserForm_Initialize.

The code was this

.List = Rng.Offset(1).Resize(Rng.Rows.Count - 1, Rng.Columns.Count).Value

and i changed it to this

.List = Rng.Offset(0).Resize(Rng.Rows.Count - 0, Rng.Columns.Count).Value

full code for info only

Private Sub UserForm_Initialize()
On Error Resume Next

ListBox1.ColumnCount = 3
   ListBox1.List = Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
'>Shows product list COLUMN from sheet to userform listbox1
   Dim ws As Worksheet
   Dim Rng As Range
   Dim i As Long, j As Long, rw As Long
   Dim Myarray() As String
     
     '~~> Change your sheetname here
   Set ws = Sheets("Products")
     
     '~~> Set you relevant range here
   Set Rng = ws.Range("A1").CurrentRegion
     
   With Me.ListBox1
       .Clear
       .ColumnHeads = False
       .ColumnCount = Rng.Columns.Count
         .List = Rng.Offset(0).Resize(Rng.Rows.Count - 0, Rng.Columns.Count).Value
        '.List = rng.Value
         
         '~~> Set the widths of the column here. Ex: For 5 Columns
         '~~> Change as Applicable
        .ColumnWidths = "50;175;60"
      '  .TopIndex = 0
         
         '>Enable edit button turn to False
        ListEditTB.Enabled = False
    End With
End Sub

 

[Peter_SSs]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules. Be sure to follow & read the link at the end of the rule too!

Cross posted at: ListBox move data to Dormant

If you do cross-post in the future and also provide a link, then there shouldn’t be a problem.