Copy 3 rows above and insert?

hxrolan091

New Member
Joined
Jul 29, 2021
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
Hi

I need help with this macro code. I just want to copy the content of 3 above with the number (91) and insert the copied rows below it and loop it.


excelrowscopyandinsert334.jpg


and secondly. I have thousands of rows (17501). Is there other ways to speed up the copy and insert process?

Here is the marco code. I just can't seem to get the right.

Thanks in advance!!

VBA Code:
Public Sub CopyRows()

Dim Col As Variant
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Col = "D"
StartRow = 2
LastRow = Sheets("Sheet1").Cells(Rows.Count, Col).End(xlUp).Row

Application.ScreenUpdating = False

With Sheets("Sheet1")
    For R = LastRow To StartRow + 1 Step -1
        If .Cells(R, Col) = "91" Then
            'Cells(R + 1, Col).Offset(-3, 0).EntireRow.Copy
            '.Cells(R, Col).EntireRow.Insert Shift:=xlDown
            .Cells(R + 1, Col).EntireRow.Copy
            .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
        End If
Next R
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True
    
End Sub


Thanks in advance!!
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,481
Office Version
  1. 365
Platform
  1. Windows
Welcome to the Board!

Will your current data always be in clocks of 3 like that (as far as column D is concerned)?
Can you show us an image of your expected output after the code runs?
 

hxrolan091

New Member
Joined
Jul 29, 2021
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
Thank you for your quick reply! I need the copied rows below to be exactly as above 3 rows (as in the pic).

before-and-efter.png
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,481
Office Version
  1. 365
Platform
  1. Windows
Try this code:
VBA Code:
Sub MyCopy()

    Dim lastRow As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column D
    lastRow = Cells(Rows.Count, "D").End(xlUp).Row
    
'   Loop through rows backwards in blocks of 3
    For r = lastRow To 1 Step -3
'       Check value of column D
        If Cells(r, "D") = 91 Then
'           Insert three blank rows
            Rows(r + 1 & ":" & r + 3).Insert
'           Copy rows above down
            Range(Cells(r - 2, "A"), Cells(r, "E")).Copy Cells(r + 1, "A")
        End If
    Next r
   
    Application.ScreenUpdating = True
    
End Sub
 

hxrolan091

New Member
Joined
Jul 29, 2021
Messages
5
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Try this code:
VBA Code:
Sub MyCopy()

    Dim lastRow As Long
    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row with data in column D
    lastRow = Cells(Rows.Count, "D").End(xlUp).Row
   
'   Loop through rows backwards in blocks of 3
    For r = lastRow To 1 Step -3
'       Check value of column D
        If Cells(r, "D") = 91 Then
'           Insert three blank rows
            Rows(r + 1 & ":" & r + 3).Insert
'           Copy rows above down
            Range(Cells(r - 2, "A"), Cells(r, "E")).Copy Cells(r + 1, "A")
        End If
    Next r
  
    Application.ScreenUpdating = True
   
End Sub

Interesting. It looks like the code creates an extra the number of times.

godandbad.png


My other macro do the same as above:

VBA Code:
    Dim Col As Variant
    Dim BlankRows As Long
    Dim lastRow As Long
    Dim r As Long
    Dim StartRow As Long

    Col = "D"
    StartRow = 1
    BlankRows = 1

    lastRow = Cells(Rows.Count, Col).End(xlUp).Row

    Application.ScreenUpdating = False

    With ActiveSheet
        For r = lastRow To StartRow + 3 Step -1
            If .Cells(r, Col) = "91" Then
                .Cells(r, Col).Resize(3).EntireRow.Copy
                .Cells(r, Col).EntireRow.Insert Shift:=xlUp
            End If
        Next r
    End With

Thanks for any help!
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,481
Office Version
  1. 365
Platform
  1. Windows
Hmmm...

I tried to recreate the example you posted up in post number 3, and it worked just fine for me.

I suspect your real data isn't quite what you showed (as you only showed a portion of it).
I assumed that you always had blocks of 3 (I even asked you to confirm that, but you never responded to that question).

Can you upload the file that you are trying to run this on, so I can see what all the data really looks like?
You will need to upload it to a file sharing site and provide a link to it.
 

hxrolan091

New Member
Joined
Jul 29, 2021
Messages
5
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

It's work fine for the first part. Scroll down further that corresponds to the number 91 been replaced by number 33.

33nowhere.png


Here is the test file as requested.
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,481
Office Version
  1. 365
Platform
  1. Windows
It's work fine for the first part. Scroll down further that corresponds to the number 91 been replaced by number 33.
That is because your actual data does not always reflect the pattern shown in the sample data your originally posted.
In the data you posted, all the data posted occurred in blocks of 3, when looking at the "Tag" field (3 records of "2", then 3 records of "33", 3 records of "91", 3 records of "11", etc). But in looking at your actual data file you just posted, you have some records of "11" that appear in blocks of 4.

I asked you a few times if this is always the case (if they always appeared in groups of 3), and you did not answer those questions. Remember, all that we have to go on is what you provide to us. So if you do not provide us with good, representative data and answer all the questions we ask, we are forced to make assumptions based on what you have posted. So the code that I posted does in fact answer the question you asked, and works on the data you originally presented, but not on all of your actual data because you left out some key details.

We might be able to come at this from a different angle, but need more information from you.
Will these blocks of 91 that you want to copy ALWAYS/ONLY appear in blocks of 3?
If they may appear in blocks of 4, like the 11s sometimes do, do you still only want to copy 3 records?
If so, which 3 of the 4 get copied, and which one doesn't?
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,481
Office Version
  1. 365
Platform
  1. Windows
If 91 can only appear in blocks of 3, then this variation of the code I posted should work, regardless of how many times other blocks may appear.
VBA Code:
Sub MyCopy()

    Dim lastRow As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column D
    lastRow = Cells(Rows.Count, "D").End(xlUp).Row
    
'   Loop through rows backwards in blocks of 3
    r = lastRow
    Do Until r <= 1
'       Check value of column D
        If Cells(r, "D") = 91 Then
'           Insert three blank rows
            Rows(r + 1 & ":" & r + 3).Insert
'           Copy rows above down
            Range(Cells(r - 2, "A"), Cells(r, "E")).Copy Cells(r + 1, "A")
'           Move up three rows
            r = r - 3
        Else
'           Move up one row
            r = r - 1
        End If
    Loop
   
    Application.ScreenUpdating = True
    
End Sub
 
Solution

hxrolan091

New Member
Joined
Jul 29, 2021
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
The mistake was mine. I got my patterns somehow mixed up. It's supposed to be like "3 records of (2), 3 records of (33), 3 records of (91) and 3 records of (11)". I wonder why I didn't see it there before :confused:

The code at #4 works perfectly fine. Thank you for your time and effort in helping me, it save me an incredible amount of hours to copy and paste.
 

Forum statistics

Threads
1,144,162
Messages
5,722,845
Members
422,460
Latest member
VBA_Noob01

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
Top