# VBA to find and move

Can an expert help me out with this please. I have attached a file that should make it clear.

Check Col ‘V’ for any amounts other than zero.

If there is an amount select the cell below the amount then insert a new row
Move the amount from ‘V’ and put into the cell below in ‘U’
Move the data from ‘R’ and put into the cell below in ‘Q’
Copy the data in ‘P’ and put in cell below.

Repeat for any other amounts.

then

Check Col ‘W’ for anything other than zero’s
Select the cell below the amount then insert a 2 new rows
Copy the amount and put into the new row in ‘U’ as a minus.
Copy the data in P,Q and put in line below
Now select the original amount and move it under the minus amount [as a plus]

Move the data from ‘R’ and put that in the ‘Q’ [2 lines below]
Copy the data from P in the original row and put into ‘P’ in the blank cell.

Repeat for any other amounts.
Find-and-Move.xlsx
###### Who is Participating?

x

Excel & VBA ExpertCommented:
Try something like this......

``````Sub ReArrangeData()
Dim Rng As Range, Cell As Range
Dim lr As Long, i As Long

Application.ScreenUpdating = False
lr = Cells(Rows.Count, "V").End(xlUp).Row
For i = lr To 2 Step -1
If Cells(i, "V") <> 0 Then
Rows(i + 1).Insert
Cells(i, "V").Select
Cells(i, "P").Copy Cells(i + 1, "P")
Cells(i, "R").Cut Cells(i + 1, "Q")
Cells(i, "V").Cut Cells(i + 1, "U")
End If
Next i

lr = Cells(Rows.Count, "W").End(xlUp).Row
For i = lr To 2 Step -1
If Cells(i, "W") <> 0 Then
Rows(i + 1).Resize(2).Insert
Cells(i, "P").Copy Cells(i + 1, "P").Resize(2)
Cells(i, "Q").Copy Cells(i + 1, "Q").Resize(2)
Cells(i, "R").Cut Cells(i + 2, "Q")
Cells(i + 1, "U") = Cells(i, "W") * -1
Cells(i + 2, "U") = Cells(i, "W")
Cells(i, "W").ClearContents
End If
Next i
Application.ScreenUpdating = True
End Sub
``````
0

Author Commented:
not something like that exactly like that. Brilliant many thanks
0

Excel & VBA ExpertCommented:
You're welcome. Thanks for the feedback.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.