Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Insertion of blank row in between every 5th row using a macro

Posted on 2014-08-04
10
Medium Priority
?
168 Views
Last Modified: 2014-08-07
Dear Experts:

I would like to run a macro that ...
... inserts a blank row in between every 5th row on the current worksheet.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
0
Comment
Question by:AndreasHermle
  • 4
  • 2
  • 2
  • +2
10 Comments
 
LVL 54

Expert Comment

by:Rgonzo1971
ID: 40238598
Hi,

pls try

Sub macro()

Idx = 5
Do Until Range("A" & Idx) = ""
    Range("A" & Idx).EntireRow.Insert
    Idx = Idx + 5
Loop

End Sub

Regards
0
 
LVL 34

Assisted Solution

by:Rob Henson
Rob Henson earned 668 total points
ID: 40238746
Rgonzo1971 - slight issue which I see in your routine, assuming I am interpreting correctly.

First run will insert row at row 5, correctly. Second Run (Idx + 5 ) will insert row at row 10, based on original rows, should this have gone in at the now new row 11; third run same issue, new row at row 15 but this will now be 2 rows out.

Maybe using ActiveCell.Offset would be better:

Sub InsertRows()

Range("A6").Select
Do Until ActiveCell.Value = ""
Selection.EntireRow.Insert
ActiveCell.Offset(5,0).Select
Loop

End Sub

Thanks
Rob H
0
 
LVL 54

Accepted Solution

by:
Rgonzo1971 earned 668 total points
ID: 40238779
@ Rob
Sure, I had a probably wrong interpretation of the question.
for groups of 5 lines

Sub macro()
Idx = 6
Do Until Range("A" & Idx) = ""
    Range("A" & Idx).EntireRow.Insert
    Idx = Idx + 6
Loop

End Sub
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 50

Expert Comment

by:Martin Liss
ID: 40238979
It's easier to do it backward, and this macro avoids the screen flickering.
Sub InsertBlankRows()
Dim lngIndex As Long

Application.ScreenUpdating = False

With Sheets("Sheet1") ' change the name of the sheet if necessary
    For lngIndex = .UsedRange.Rows.Count - 4 To 2 Step -5
        .Cells(lngIndex, 1).EntireRow.Insert
    Next
End With

Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 40239602
Here is another method...

Option Explicit

Sub kTest()
    
    Dim r   As Long, rs As Long, c As Long
    
    Application.ScreenUpdating = False
    
    With Range("a1").CurrentRegion
        r = .Rows.Count
        c = .Columns.Count
    End With
    
    Columns(1).Insert
    With Range("a2:a" & r)
        .Formula = "=int((rows(a$2:a2)-1)/5)+1"
        .Value = .Value
    End With
    Range("a" & r + 1).Value = 1
    rs = Range("a" & r).Value
    Range("a" & r + 1).AutoFill Destination:=Range("a" & r + 1).Resize(rs), Type:=xlFillSeries
    
    Range("a2").Resize(rs + r - 1, c + 1).Sort Range("a2"), 1, Header:=2
    Columns(1).Delete
    Application.ScreenUpdating = True
    
End Sub

Open in new window


Kris
0
 

Author Comment

by:AndreasHermle
ID: 40239885
Dear all:

thank you very much for this superb and overwhelming support.  Sorry for not getting back to you earlier.

I will test your approaches and let you know tomorrow. Thank you again.

Regards, Andreas
0
 

Author Comment

by:AndreasHermle
ID: 40240823
Dear all,

Codes by Rob Henson and Rgonzo work just fine. Thank you very much for it.

The more 'sophisticated' codes by Martin and Krishna do not work entirely properly.

I have attached a sample file (with codes included) for your convenience to show the differences.

Regards, Andreas

every5throw-insert-blank-row.xlsm
0
 
LVL 18

Assisted Solution

by:krishnakrkc
krishnakrkc earned 664 total points
ID: 40240839
I thought column header is there.  

Anyway try this version.

Sub kTest()
    'By Krishna
    
    Dim r   As Long, rs As Long, c As Long
    
    Application.ScreenUpdating = False
    
    With Range("a1").CurrentRegion
        r = .Rows.Count
        c = .Columns.Count
    End With
    
    Columns(1).Insert
    With Range("a1:a" & r)
        .Formula = "=int((rows(a$1:a1)-1)/4)+1"
        .Value = .Value
    End With
    Range("a" & r + 1).Value = 1
    rs = Range("a" & r).Value
    Range("a" & r + 1).AutoFill Destination:=Range("a" & r + 1).Resize(rs), Type:=xlFillSeries
    
    Range("a1").Resize(rs + r - 1, c + 1).Sort Range("a1"), 1, Header:=2
    Columns(1).Delete
    Application.ScreenUpdating = True
    
End Sub

Open in new window


Kris
0
 

Author Comment

by:AndreasHermle
ID: 40240862
Ok, krishna, this did the trick. Thank you very much for it.

Regards, Andreas
0
 

Author Closing Comment

by:AndreasHermle
ID: 40247863
Thank you very much for your great and professional support. I really appreciate it.

Regards, Andreas
0

Featured Post

Become an Android App Developer

Ready to kick start your career in 2018? Learn how to build an Android app in January’s Course of the Month and open the door to new opportunities.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
How can you see what you are working on when you want to see it while you to save a copy? Add a "Save As" icon to the Quick Access Toolbar, or QAT. That way, when you save a copy of a query, form, report, or other object you are modifying, you…

569 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question