How to shift rows without copy paste

[Shivi0189]

I have a large no. of entries in excel like below:

BOAT NO LOT NO Density STATUS F2/146 5820 10.48 10.49 10.48 10.5 10.49 ACC 10.49 10.49 10.49 F2/149 5820 10.47 10.47 10.47 10.47 10.44 RS 10.47 10.47 10.47 F2/150 5820 10.47 10.47 10.49 10.45 10.47 ACC 10.47 10.46 10.48 F2/153 5843 10.53 10.53 10.54 10.53 10.56 ACC 10.55 10.55 10.55 F2/154 5843 10.52 10.53 10.52 10.52 10.51 ACC 10.51 10.52 10.52 <colgroup><col span="2"><col><col span="5"></colgroup><tbody> </tbody>

<colgroup><col span="2"><col><col span="5"></colgroup><tbody>
</tbody>

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!

 

[tyija1995]

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

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!!

 

[MickG]

Another option:-

[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

 

[tyija1995]

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

 

[Shivi0189]

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.

 

[Shivi0189]

Thank You! This helped but not completely. I am getting mixed results like below:

F3/356	6065				10.69	10.69				ACC
F3/357	6065				10.67	10.68				ACC
F3/358	6065				10.66	10.65				ACC
F3/359	6065				10.68	10.67				ACC
F3/360	6065	10.73	10.67	10.68	10.67	10.56	10.67	10.32	10.67	REJ
F3/361	6067	10.66	10.62	10.66	10.63	10.61	10.67	10.63	10.66	ACC

<colgroup><col span="2"><col><col span="8"></colgroup><tbody>
</tbody>

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.

 

[Rick Rothstein]

If I am not mistaken, I think this non-looping macro will do what you want...

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

 

[Shivi0189]

Another option:-

[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!