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

 

[MikeVol]

    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

        Dim customerName As String
        customerName = Me.TextBox1.Text

        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

        Dim foundRow As Range
        Set foundRow = .Columns("A").Find(What:=customerName, LookAt:=xlWhole, _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious)

        If Not foundRow Is Nothing Then
            foundRow.EntireRow.Delete Shift:=xlUp
        End If

    End With

 

[ipbr21054]

Using that code i enter the row i wish it to be moved to & press enter button.
I see the screen flash as if something happened, the userform values are all cleared but i see its still in the same row without being moved.

 

[ipbr21054]

See here in short clip.
I select to move to row 25 & i see it pasted but then gone etc.

SHORT CLIP

 

[MikeVol]

Ok, try to move customer "CLAUDIA", row 20 to... Check your file.

 

[NoSparks]

try this

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 = .ActiveCell.Row     '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]

@NoSparks

I get the following RTE & when i debug the line shown below is in Yellow

 x = .ActiveCell.Row     'original row being dealt with

 

[ipbr21054]

Should you need to see other code on that page then below

Private Sub DeleteCustomer_Click()
    Dim tblName As String
    Dim tbl As ListObject
    Dim R As Long
    Dim lr As Long
    Dim i As Long
    Dim ActiveTableRow As Long
    
    If ActiveCell.Column = 1 Then ' THIS IS THE COLUMN FOR WHICH YOU SELECT CUSTOMER TO BE DELETED
    If MsgBox("DELETE CUSTOMER " & ActiveCell.Value & "  ?", vbYesNo + vbInformation, "DELETE CUSTOMER FROM DATABASE") = vbYes Then
        ActiveTableRow = Selection.Row - Selection.ListObject.Range.Row
        Selection.ListObject.ListRows(ActiveTableRow).Delete
    End If
        Else
        MsgBox "YOU MUST SELECT CUSTOMER IN COLUMN A", vbCritical, "NO CUSTOMER WAS SELECTED"
    End If

End Sub

Private Sub MoveCustomer_Click()
    If ActiveCell.Column = 1 Then
        MoveCustomerRow.Show
    Else
        MsgBox "YOU DIDNT SELECT A CUSTOMER IN COLUMN A", vbCritical, "MOVE CUSTOMER ROW MESSAGE"
    End If

End Sub
Private Sub Worksheet_Activate()
Range("A1").Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim Cell As Range
    
    Set rng = Intersect(Target, Range("A5:L" & Rows.Count))
    
    If rng Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    For Each Cell In rng
    If Not Cell.HasFormula Then Cell.Value = UCase(Cell.Value)
    Next Cell
    Application.EnableEvents = False
    
    If Target.Column = 4 Then ' THIS CODE PUTS A SPACE BETWEEN POST CODE
    On Error Resume Next
    If Len(Target) = 6 Then
      Target = Left(Target, 3) & " " & Right(Target, 3)
    ElseIf Len(Target) = 7 Then
      Target = Left(Target, 4) & " " & Right(Target, 3)
    End If
    End If
    If Target.Column = 3 Then ' THIS CODE PUTS A SPACE BETWEEN TELEPHONE NUMBER
    On Error Resume Next
    If Len(Target) = 11 Then Target = Left(Target, 5) & " " & Right(Target, 6)
    Application.EnableEvents = True
    End If
    On Error GoTo 0
    Application.EnableEvents = True
    
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' THIS WILL COLOUR ACTIVE CELL & KEEP INTERIOR COLOUR ONCE LEFT HAS BEEN LEFT
    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range

    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "NEVER" Or Target.Value Like "2###" Then Exit Sub


    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "L"

'   *** Specify start row ***
    myStartRow = 5
    
'   Use first column to find the last row
    myLastRow = Cells(Rows.Count, myStartCol).End(xlUp).Row
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
    With Range("A" & Target.Row & ":L" & Target.Row)
        .Worksheet.Cells.FormatConditions.Delete
        .FormatConditions.Add xlExpression, , True
        .FormatConditions(1).Interior.Color = vbWhite
    End With

  End Sub

 

[ipbr21054]

Ok, try to move customer "CLAUDIA", row 20 to... Check your file.

Unable to try that as i see my cursor is a large cross & design mode isnt selected

 

[MikeVol]

Last chance

Option Explicit

Private Sub TransferData_Click()
    Dim i           As Integer

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

    Dim rowNum      As Integer
    rowNum = CInt(Application.InputBox("WHICH ROW SHOULD DATA BE INSERTED INTO ?", "NEW CUSTOMER ROW NUMBER MESSAGE", Type:=1))

    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 z           As ListRow
    Set z = 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)

        Select Case i
            Case -1
                tbl.DataBodyRange(rowNum, i + 1).Value = Val(ControlsArr(i))
                ControlsArr(i).Text = ""

            Case Else
                tbl.DataBodyRange(rowNum, i + 1).Value = ControlsArr(i)
                ControlsArr(i).Text = ""
        End Select

    Next i

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

    If Not foundRow Is Nothing Then
        tbl.ListRows(foundRow.Row - tbl.DataBodyRange.Row + 1).Delete
    End If

    Application.Goto tbl.DataBodyRange.Cells(1, 1)
    
    Set foundRow = Nothing
    Set z = Nothing
    Set tbl = Nothing

    ActiveWorkbook.Save
    Unload MoveCustomerRow
End Sub

Everything works fine on my side. Good luck.