How to shift rows without copy paste

Shivi0189

New Member
Joined
Apr 1, 2019
Messages
8
I have a large no. of entries in excel like below:

[TABLE="width: 530"]
<colgroup><col span="2"><col><col span="5"></colgroup><tbody>[TR]
[TD][TABLE="width: 530"]
<colgroup><col span="2"><col><col span="5"></colgroup><tbody>[TR]
[TD]BOAT
NO
[/TD]
[TD]LOT NO[/TD]
[TD="colspan: 5, align: center"]Density [/TD]
[TD]STATUS[/TD]
[/TR]
[TR]
[TD]F2/146[/TD]
[TD]5820[/TD]
[TD]10.48[/TD]
[TD="align: right"]10.49[/TD]
[TD="align: right"]10.48[/TD]
[TD="align: right"]10.5[/TD]
[TD="align: right"]10.49[/TD]
[TD] ACC[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]10.49[/TD]
[TD="align: right"]10.49[/TD]
[TD="align: right"]10.49[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]F2/149[/TD]
[TD]5820[/TD]
[TD]10.47[/TD]
[TD="align: right"]10.47[/TD]
[TD="align: right"]10.47[/TD]
[TD="align: right"]10.47[/TD]
[TD="align: right"]10.44 [/TD]
[TD] RS[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]10.47[/TD]
[TD="align: right"]10.47[/TD]
[TD="align: right"]10.47[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]F2/150[/TD]
[TD]5820[/TD]
[TD]10.47[/TD]
[TD="align: right"]10.47[/TD]
[TD="align: right"]10.49[/TD]
[TD="align: right"]10.45[/TD]
[TD="align: right"]10.47[/TD]
[TD] ACC[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]10.47[/TD]
[TD="align: right"]10.46[/TD]
[TD="align: right"]10.48[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]F2/153[/TD]
[TD]5843[/TD]
[TD]10.53[/TD]
[TD="align: right"]10.53[/TD]
[TD="align: right"]10.54[/TD]
[TD="align: right"]10.53[/TD]
[TD="align: right"]10.56 [/TD]
[TD] ACC[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]10.55[/TD]
[TD="align: right"]10.55[/TD]
[TD="align: right"]10.55[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]F2/154[/TD]
[TD]5843[/TD]
[TD]10.52[/TD]
[TD="align: right"]10.53[/TD]
[TD="align: right"]10.52[/TD]
[TD="align: right"]10.52[/TD]
[TD="align: right"]10.51[/TD]
[TD] ACC[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD]10.51[/TD]
[TD="align: right"]10.52[/TD]
[TD="align: right"]10.52[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD="colspan: 5, align: center"][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
The boat no. has been assigned a lot no. & 8 density values are recorded in two rows. I want them to arrange in single row against each boat & lot no. for statistical analysis.
Any help will be of great use.
Thanks in advance!
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Hi,

I have come up with somewhat of a solution (at least it worked for the example data provided from your post)

Firstly, create 3 new columns by insertion from highlighting the Status column (Column H) so that Status now shows in column K and H,I,J are now blank.

In Column L I created a helper formula, e.g. in cell L3:
=COUNT(C3:G3)
which returns 5 or 3 - drag this down all of the rows until the bottom row.

Then I made this code to cut and paste where the helper formula = 3 to the above line where helper formula = 5

Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim i As Long
    Dim lastRowL As Long
    
    lastRowL = Cells(Rows.Count, 12).End(xlUp).Row
    For i = 3 To lastRowL
        If Cells(i, 12).Value = 3 Then
            Range(Cells(i, 3), Cells(i, 5)).Select
            Selection.Cut
            Cells(i - 1, 8).Select
            ActiveSheet.Paste
        End If
    Next i
    
End Sub

I hope this helps with a larger data set, let me know!

There are definitely more efficient ways but I can't think of them with my current knowledge level! :P

Once this is done you can then delete the helper column if you wish.

I'd save before running this just incase, or make a backup file!!
 
Last edited:
Upvote 0
Another option:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG01Apr49
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Application.ScreenUpdating = False
Lst = Range("C" & Rows.Count).End(xlUp).Row
Range("H:H").Resize(, 3).Insert
    [COLOR="Navy"]For[/COLOR] n = Lst To 3 [COLOR="Navy"]Step[/COLOR] -2
        Range("C" & n).Resize(, 3).Cut Range("H" & n - 1)
    [COLOR="Navy"]Next[/COLOR] n
Range("A1").Resize(Lst).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Just noticed this code leaves a row gap between each boat No.

This can be changed if the code is edited to say:
Rows(i).Delete Shift:=xlUp
After the "ActiveSheet.Paste"
but before End If
 
Upvote 0
Thank you but "Then I made this code to cut and paste where the helper formula = 3 to the above line where helper formula = 5" I am unable to understand this line.
I am beginner in VBA and may not be able to catch whatever you are trying to explain. A little elaboration may help.
 
Upvote 0
Thank You! This helped but not completely. I am getting mixed results like below:

[TABLE="width: 722"]
<colgroup><col span="2"><col><col span="8"></colgroup><tbody>[TR]
[TD]F3/356[/TD]
[TD="align: right"]6065[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]10.69[/TD]
[TD="align: right"]10.69[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]ACC[/TD]
[/TR]
[TR]
[TD]F3/357[/TD]
[TD="align: right"]6065[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]10.67[/TD]
[TD="align: right"]10.68[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]ACC[/TD]
[/TR]
[TR]
[TD]F3/358[/TD]
[TD="align: right"]6065[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]10.66[/TD]
[TD="align: right"]10.65[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]ACC[/TD]
[/TR]
[TR]
[TD]F3/359[/TD]
[TD="align: right"]6065[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]10.68[/TD]
[TD="align: right"]10.67[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]ACC[/TD]
[/TR]
[TR]
[TD]F3/360[/TD]
[TD="align: right"]6065[/TD]
[TD="align: right"]10.73[/TD]
[TD="align: right"]10.67[/TD]
[TD="align: right"]10.68[/TD]
[TD="align: right"]10.67[/TD]
[TD="align: right"]10.56[/TD]
[TD="align: right"]10.67[/TD]
[TD="align: right"]10.32[/TD]
[TD="align: right"]10.67[/TD]
[TD]REJ[/TD]
[/TR]
[TR]
[TD]F3/361[/TD]
[TD="align: right"]6067[/TD]
[TD="align: right"]10.66[/TD]
[TD="align: right"]10.62[/TD]
[TD="align: right"]10.66[/TD]
[TD="align: right"]10.63[/TD]
[TD="align: right"]10.61[/TD]
[TD="align: right"]10.67[/TD]
[TD="align: right"]10.63[/TD]
[TD="align: right"]10.66[/TD]
[TD]ACC
[/TD]
[/TR]
</tbody>[/TABLE]

Some of the data is getting converted to desired results but in between I am loosing data for some enteries. I am new to VBA so I'll tell you how I did.
I copied the code & in my worksheet I pressed ALT+F11. I went to Insert option, then module then pasted the code. Went to file option and clicked on "close & return to MS Excel". In my workbook, I clicked view->Macros->view macros->run.
The first workbook I tried in, I could get the results but another workbook I got something like shown above.
 
Upvote 0
If I am not mistaken, I think this non-looping macro will do what you want...
Code:
Sub Densities()
  Application.ScreenUpdating = False
  Columns("H").Resize(, 3).Insert
  With Range("H2:J" & Cells(Rows.Count, "C").End(xlUp).Row)
    .FormulaR1C1 = "=R[1]C[-5]"
    .Value = .Value
  End With
  Columns("B").SpecialCells(xlBlanks).EntireRow.Delete
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Another option:-
Code:
[COLOR=Navy]Sub[/COLOR] MG01Apr49
[COLOR=Navy]Dim[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Lst [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
Application.ScreenUpdating = False
Lst = Range("C" & Rows.Count).End(xlUp).Row
Range("H:H").Resize(, 3).Insert
    [COLOR=Navy]For[/COLOR] n = Lst To 3 [COLOR=Navy]Step[/COLOR] -2
        Range("C" & n).Resize(, 3).Cut Range("H" & n - 1)
    [COLOR=Navy]Next[/COLOR] n
Range("A1").Resize(Lst).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick

Hey! The code works perfectly fine. There were some mistakes in my workbook itself. Thank a lot!
 
Upvote 0

Forum statistics

Threads
1,223,908
Messages
6,175,306
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top