After moving original row details to a new row have the code delete the original row details

[ipbr21054]

I have a worksheet with customers names in column A
Across the page i have values relating to that customer.

This is how it works at present.
I have a customer called TOM JONES & currently he is in row 20 BUT i need to move him to row 12

I select the customer TOM JONES in column A & click the command button, i am asked which row do i need to move him to, This is done by an input field box where i enter 12
The customer TOM JONES & his values are now shown in the new row that i advised BUT still the original TOM JONES & his values are still shown in row 20
So currently on my worksheet i have TOM JONES shown in row 20 & also TOM JONES in row 12
I then have to manually delete TOM JONES in row 20

My goal is to add some extra code to the existing code supplied below something that will delete the original instance.

Private Sub TransferData_Click()
 Dim i As Integer
 Dim ControlsArr As Variant, ctrl As Variant
 Dim x As Long
 Dim z As Integer
 
 z = CInt(Application.InputBox("WHICH ROW SHOULD DATA BE INSERTED INTO ?", "NEW CUSTOMER ROW NUMBER MESSAGE", Type:=1))
 
 ControlsArr = Array(Me.TextBox1, Me.TextBox2, Me.TextBox3, Me.TextBox4, Me.TextBox5, Me.TextBox6, Me.TextBox7, Me.TextBox8, Me.TextBox9, Me.TextBox10, Me.TextBox11, Me.TextBox12)
    With ThisWorkbook.Worksheets("GRASS")
    .Rows(z).EntireRow.Insert Shift:=xlDown
    .Rows(z).RowHeight = 25
    .Rows(z).Font.Color = vbBlack
    .Rows(z).Font.Bold = True
    .Rows(z).Font.Size = 16
    .Rows(z).Font.Name = "Calibri"
    Range(.Cells(z, "A"), .Cells(z, "l")).Borders.LineStyle = xlContinuous
    For i = 0 To UBound(ControlsArr)
    Select Case i
    Case -1
    .Cells(z, i + 1) = Val(ControlsArr(i))
    ControlsArr(i).Text = ""

    Case Else
    .Cells(z, i + 1) = ControlsArr(i)
    ControlsArr(i).Text = ""
    End Select
    Next i
    End With

 ActiveWorkbook.Save
    
 Unload MoveCustomerRow
 
End Sub

 

[ipbr21054]

Sorry but that was the same.
No joy

 

[MikeVol]

Oops, my mistake, sorry. I didn't notice that when I move a row down, the row is immediately deleted. Here is the correct code.

Option Explicit

Private Sub TransferData_Click()
    Dim i           As Long
    Dim oldRowIndex As Long

    Dim tbl         As ListObject
    Set tbl = ThisWorkbook.Worksheets("GRASS").ListObjects("Table2")

    Dim rowNum      As Long
    rowNum = CInt(Application.InputBox("WHICH ROW SHOULD DATA BE INSERTED INTO ?" _
            & vbCrLf & vbCrLf & "IF YOU NEED TO MOVE THE SELECTED ROW DOWN, ENTER 2 ROW LESS! " _
            & vbCrLf & vbCrLf & "IF YOU NEED TO MOVE THE SELECTED ROW UP, ENTER 3 ROW LESS! ", "NEW CUSTOMER ROW NUMBER MESSAGE", Type:=1))
    '    Debug.Print "Selected row is " & rowNum

    If rowNum < 1 Or rowNum > tbl.ListRows.Count + 1 Then
        MsgBox "Invalid row number!", vbExclamation, "Error"
        Exit Sub
    End If

    Dim customerName As String
    customerName = Me.TextBox1.Text

    Dim foundRow    As Range
    Set foundRow = tbl.DataBodyRange.Columns(1).Find(What:=customerName, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext)

    If Not foundRow Is Nothing Then
        oldRowIndex = foundRow.Row - tbl.DataBodyRange.Row + 1
    Else
        oldRowIndex = -1
    End If

    Dim newRow      As ListRow
    Set newRow = tbl.ListRows.Add(rowNum)

    Dim ControlsArr As Variant
    ControlsArr = Array(Me.TextBox1, Me.TextBox2, Me.TextBox3, Me.TextBox4, Me.TextBox5, Me.TextBox6, Me.TextBox7, _
            Me.TextBox8, Me.TextBox9, Me.TextBox10, Me.TextBox11)

    For i = 0 To UBound(ControlsArr)
        tbl.DataBodyRange.Cells(rowNum, i + 1).Value = ControlsArr(i).Text
        ControlsArr(i).Text = ""
    Next i

    If oldRowIndex > 0 And oldRowIndex < rowNum Then
        oldRowIndex = oldRowIndex
        '        Debug.Print "Bottom move row " & oldRowIndex
    ElseIf oldRowIndex > rowNum Then
        oldRowIndex = oldRowIndex + 1
        '        Debug.Print "Top move row " & oldRowIndex
    End If

    If oldRowIndex > 0 And oldRowIndex <> rowNum Then
        tbl.ListRows(oldRowIndex).Delete
    End If

    Application.Goto tbl.DataBodyRange.Cells(1, 1)

    Set newRow = Nothing
    Set foundRow = Nothing
    Set tbl = Nothing

    ActiveWorkbook.Save
    Unload MoveCustomerRow
End Sub

 

[ipbr21054]

Sorry but with that code i can see some of my users will be messing things up seeing we have learning issues.

Thanks for your time but will see what @NoSparks can come up with

 

[MikeVol]

Look, in this code we work with ListObject in which the row number does not correspond to the number on the worksheet, since this table (headers) starts with the 3rd row of the sheet. This is not how you work with a normal range on a worksheet! It's up to you what code to use, but I see that your topic has been dragging on with this file for almost a year. Wait...

 

[NoSparks]

Oops, once the user form shows the sheet is no longer active so...
Add another text box to the user form, I've added textbox13
populate it with the active cell row in the UserForm_Initialize sub.

Private Sub UserForm_Initialize()
  Me.TextBox13 = ActiveCell.Row
End Sub

Private Sub TransferData_Click()
 Dim i As Integer
 Dim ControlsArr As Variant, ctrl As Variant
 Dim x As Integer   'original row
 Dim z As Integer   'row to insert

z = CInt(Application.InputBox("WHICH ROW SHOULD DATA BE INSERTED INTO ?", "NEW CUSTOMER ROW NUMBER MESSAGE", Type:=1))
 
ControlsArr = Array(Me.TextBox1, Me.TextBox2, Me.TextBox3, Me.TextBox4, Me.TextBox5, Me.TextBox6, Me.TextBox7, Me.TextBox8, Me.TextBox9, Me.TextBox10, Me.TextBox11, Me.TextBox12)

With ThisWorkbook.Worksheets("GRASS")
    x = Me.TextBox13.Value    'original row being dealt with
    .Rows(z).EntireRow.Insert Shift:=xlDown
    If z < x Then x = x + 1     'inserting a row above changes the location of original row
    .Rows(z).RowHeight = 25
    .Rows(z).Font.Color = vbBlack
    .Rows(z).Font.Bold = True
    .Rows(z).Font.Size = 16
    .Rows(z).Font.Name = "Calibri"
    Range(.Cells(z, "A"), .Cells(z, "l")).Borders.LineStyle = xlContinuous
    
    For i = 0 To UBound(ControlsArr)
        Select Case i
            Case -1
                .Cells(z, i + 1) = Val(ControlsArr(i))
                ControlsArr(i).Text = ""
            Case Else
                .Cells(z, i + 1) = ControlsArr(i)
                ControlsArr(i).Text = ""
        End Select
    Next i
    
    .Rows(x).Delete
    
End With

 ActiveWorkbook.Save
    
 Unload MoveCustomerRow
 
End Sub

 

[ipbr21054]

That worked well thanks

 

[MikeVol]

That worked well

I disagree with you! It doesn't work correctly! Watch the video!

 

[ipbr21054]

I now agree with you.
I did a few tests & it was fine but after moving my test row around for about 10 goes i see it places it sometimes in the next row & not the row i entered in the input field.

If this is going to be an issue we will just manually delete it like weve been doing