Delete customers row of values after my code has completed moving its copy

[ipbr21054]

Morning,
On my worksheet i have customers name in column A & their values on that row.
Sometimes i need to move them up or down the page.
So for that i do the following.

Customer say is currently at row 10 & i need to move them to row 28
I select their name in column A, my userform opens which has basicalyy just copied the rows values & i am then asked what row to place these values in.
I enter 28 in the input field & the values are now placed in the row i entered being row 28

NOW i wish to delete the details from row 10 & this is where i need the advice please as currently im scrolling up / down looking for it.

Private Sub CommandButton1_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)
    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
    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]

Doesnt work well.
This is the page
Row 25 JOHN & JAN
Row 26 SCOTT
Row 27 Lynda
Row 28 Test 1
Row 29 Test 2

I selected Test 2 & ran the code & input 28,basically it should swap around Test 1 & Test 2 positions BUT nothing happends.

I did it again selecting Test 2 & then input 27 BUT Row 25,26 & 27 stayed the same & Row 28 & 29 BOTH becamse Test2

 

[mumps]

Try:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim ControlsArr As Variant, ctrl As Variant, lRow As Long, x As Long, z As Long, i As Long
    lRow = ActiveCell.Row
    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)
    If lRow - z <> 1 Then
        With ThisWorkbook.Worksheets("GRASS")
            .Rows(z + 1).EntireRow.Insert Shift:=xlDown
            .Rows(z + 1).RowHeight = 25
            .Rows(z + 1).Font.Color = vbBlack
            .Rows(z + 1).Font.Bold = True
            .Rows(z + 1).Font.Size = 16
            .Rows(z + 1).Font.Name = "Calibri"
            Range(.Cells(z + 1, "A"), .Cells(z, "l")).Borders.LineStyle = xlContinuous
            Range(.Cells(z + 1, "A"), .Cells(z, "l")).Borders.LineStyle = xlContinuous
            For i = 0 To UBound(ControlsArr)
                Select Case i
                    Case -1
                        .Cells(z + 1, i + 1) = Val(ControlsArr(i))
                        ControlsArr(i).Text = ""
                    Case Else
                        .Cells(z + 1, i + 1) = ControlsArr(i)
                        ControlsArr(i).Text = ""
                End Select
            Next i
        End With
        Sheets("GRASS").Rows(lRow).Delete
    Else
        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
            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
        Sheets("GRASS").Rows(lRow + 1).Delete
    End If
    ActiveWorkbook.Save
    Unload MoveCustomerRow
    Application.ScreenUpdating = True
End Sub

 

[ipbr21054]

Hi,
Still doesnt put copied row in correct place that i enter row in input field.

It also doesnt delete the initial row,so i end up with two of the same rows of data

Did it work your end when you tried it ?

 

[mumps]

It works for me. Are you using the macro in the same file that you posted? If not, upload the file that s not working.

 

[ipbr21054]

I’m out at present so please send me file you have that’s working.
Cheers.

 

[mumps]

Click here to download your file.

 

[ipbr21054]

So with the file i downloaded the rows shopws this .
Row 25 Test A
Row 26 Test B
Row 27 Test C
Row 28 Test D

I select Test D & now wish to put it into Row 26, so it should then lok like so.

Row 25 Test A
Row 26 Test D
Row 27 Test B
Row 28 Test C

But what i end up with is,

Row 25 Test A
Row 26 Test B
Row 27 Test D
Row 28 Test D

 

[ipbr21054]

To make it clearer i just used 1,2,3 & 4 in rows 25 to 28

I found when moving anything in rows 25 to 27 seemed ok BUT when i tried to then move from row 28 it would duplicate itself thus overwriting where it was being placed.
Example

Row 25 1
Row 26 2
Row 27 3
Row 28 4

Clicking in Row 28 value 4 & asking to be placed in Row 26 the result was this

Row 25 1
Row 26 2
Row 27 4
Row 28 4

I put values back to 1,2,3 & 4 & try the same again but this time i select to move to row 25 but i then get 1424

As this is not working i think best leave it now.

Thanks for your time