Moving varios values from column to column

[ipbr21054]

Hi,
I currently use the coe below which does what its supposed to.
I thought as opposed to deleting the customer i would keep the records maybe for a later use.

So the current values are in columns A5:K then down the page & i thought we would paste them in columns P5:Z & down the page

Please can you advise how i would edit the code so it DOESNT delete the records BUT just paste them in the columns mentioned.

Over time the records list will become longer so it needs to be pasted in the next row after the row with values

Option Explicit

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim i As Long
  Dim lr As Long
  Dim sh As Worksheet

  Set sh = Sheets("GRASS")
  With ListBox1
    sh.Rows(.ListIndex + 5).Delete
    lr = sh.Range("B" & Rows.Count).End(xlUp).Row
    If lr > 4 Then .RowSource = sh.Name & "!A5:B" & lr
    For i = 0 To .ListCount - 1
      If .Selected(i) Then .Selected(i) = False
    Next
  End With
  Unload DeleteCustomer
  Range("A5").Select
End Sub

Private Sub UserForm_Initialize()
  Dim lr As Long
  lr = Sheets("GRASS").Range("B" & Rows.Count).End(xlUp).Row
  If lr > 4 Then ListBox1.RowSource = "GRASS!A5:B" & lr
End Sub

 

[DanteAmor]

Hi Ipbr.

I hope you are well.​

Please can you advise how i would edit the code so it DOESNT delete the records BUT just paste them in the columns mentioned.

According to your request, the record should not be deleted. Just paste the data into other columns.

Then try this:

Option Explicit

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim i As Long
  Dim lr As Long, lr2 As Long
  Dim sh As Worksheet

  Set sh = Sheets("GRASS")
  With ListBox1
    lr2 = sh.Range("Q" & Rows.Count).End(xlUp).Row + 1
    If lr2 < 5 Then lr2 = 5
    sh.Range("P" & lr2).Resize(1, 11).Value = sh.Range("A" & .ListIndex + 5).Resize(1, 11).Value
  
    lr = sh.Range("B" & Rows.Count).End(xlUp).Row
    If lr > 4 Then .RowSource = sh.Name & "!A5:B" & lr
    For i = 0 To .ListCount - 1
      If .Selected(i) Then .Selected(i) = False
    Next
  End With
  Unload DeleteCustomer
  Range("A5").Select
End Sub

Private Sub UserForm_Initialize()
  Dim lr As Long
  lr = Sheets("GRASS").Range("B" & Rows.Count).End(xlUp).Row
  If lr > 4 Then ListBox1.RowSource = "GRASS!A5:B" & lr
End Sub

--------------​

But if you change your mind and want to paste the data into other columns and then delete the record in columns A through K, then try this:

Option Explicit

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim i As Long, j As Long
  Dim lr As Long, lr2 As Long
  Dim sh As Worksheet

  Set sh = Sheets("GRASS")
  With ListBox1
    lr2 = sh.Range("Q" & Rows.Count).End(xlUp).Row + 1
    If lr2 < 5 Then lr2 = 5
    j = .ListIndex + 5
  
    sh.Range("P" & lr2).Resize(1, 11).Value = sh.Range("A" & j).Resize(1, 11).Value
  
    sh.Range("A" & j & ":K" & j).Delete Shift:=xlUp
  
    lr = sh.Range("B" & Rows.Count).End(xlUp).Row
    If lr > 4 Then .RowSource = sh.Name & "!A5:B" & lr
    For i = 0 To .ListCount - 1
      If .Selected(i) Then .Selected(i) = False
    Next
  End With
  Unload DeleteCustomer
  Range("A5").Select
End Sub

Private Sub UserForm_Initialize()
  Dim lr As Long
  lr = Sheets("GRASS").Range("B" & Rows.Count).End(xlUp).Row
  If lr > 4 Then ListBox1.RowSource = "GRASS!A5:B" & lr
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

 

[ipbr21054]

Hi,
I went with your second code,thannks.
It worked well until i added some items,shown in red.
I added some border lines just to make tharea bigger & advise people value would be soon entered here.
See screenshot of where the code now places the values & notice my extra code isnt applied ?

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim i As Long, j As Long
  Dim lr As Long, lr2 As Long
  Dim sh As Worksheet

  Set sh = Sheets("GRASS")
  With ListBox1
    lr2 = sh.Range("Q" & Rows.Count).End(xlUp).Row + 1
    If lr2 < 5 Then lr2 = 5
    j = .ListIndex + 5
  
    sh.Range("P" & lr2).Resize(1, 11).Value = sh.Range("A" & j).Resize(1, 11).Value
    .Font.Size = 16
    .Font.Bold = True
    .Font.Name = "Calibri"
    sh.Range("A" & j & ":K" & j).Delete Shift:=xlUp
  
    lr = sh.Range("B" & Rows.Count).End(xlUp).Row
    If lr > 4 Then .RowSource = sh.Name & "!A5:B" & lr
    For i = 0 To .ListCount - 1
      If .Selected(i) Then .Selected(i) = False
    Next
  End With
  Unload MOVECUSTOMER
  Range("A5").Select
End Sub

 

[DanteAmor]

Hi ipbr:

That part of the code is inside the With statement of the ListBox1, you can't use them that way since they are not properties of the ListBox, those are properties of the sheet.

  With ListBox1
    lr2 = sh.Range("Q" & Rows.Count).End(xlUp).Row + 1
    If lr2 < 5 Then lr2 = 5
    j = .ListIndex + 5
  
    sh.Range("P" & lr2).Resize(1, 11).Value = sh.Range("A" & j).Resize(1, 11).Value
    .Font.Size = 16
    .Font.Bold = True
    .Font.Name = "Calibri"

I don't quite understand where you want to apply the cell formatting, but I'm guessing it's the cells in columns P to Z.
I tell you that this is not what you requested in your original request, however I give you a proposal:
So it should be like this:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim i As Long, j As Long
  Dim lr As Long, lr2 As Long
  Dim sh As Worksheet

  Set sh = Sheets("GRASS")
  With ListBox1
    lr2 = sh.Range("Q" & Rows.Count).End(xlUp).Row + 1
    If lr2 < 5 Then lr2 = 5
    j = .ListIndex + 5
  End With
  
  With sh.Range("P" & lr2).Resize(1, 11)
    .Value = sh.Range("A" & j).Resize(1, 11).Value
    
    .Font.Size = 16
    .Font.Bold = True
    .Font.Name = "Calibri"
  End With
  
  With ListBox1
    sh.Range("A" & j & ":K" & j).Delete Shift:=xlUp
    
    lr = sh.Range("B" & Rows.Count).End(xlUp).Row
    If lr > 4 Then .RowSource = sh.Name & "!A5:B" & lr
    For i = 0 To .ListCount - 1
      If .Selected(i) Then .Selected(i) = False
    Next
  End With
  Unload DeleteCustomer
  Range("A5").Select
End Sub