?
Solved

vba- Insert Raws in excel

Posted on 2016-08-03
6
Medium Priority
?
103 Views
Last Modified: 2016-08-03
Hello,
Can you please help with a code that Insert rows between cells (Column "C", "QA:"), Starting row 2.
if rows Between QA: and QA: is less than 18, then add rows at the end.
if Rows Between QA: and QA: more than 18, then delete rows at the end.

I have dynamic number of rows.
Please sample attached.
Thank you.
Sample.xlsx
0
Comment
Question by:W.E.B
  • 2
  • 2
  • 2
6 Comments
 
LVL 36

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41740938
Please try this.....
Sub InsertRows()
Dim rng As Range
Dim n As Long
Application.ScreenUpdating = False
For Each rng In Range("C:C").SpecialCells(xlCellTypeConstants, 1).Areas    
    If rng.Cells(rng.Rows.Count) < 18 Then
        n = 18 - rng.Cells(rng.Rows.Count)
        rng.Cells(rng.Rows.Count + 1).Resize(n).EntireRow.Insert
    ElseIf rng.Cells(rng.Rows.Count) > 18 Then
        n = rng.Cells(rng.Rows.Count) - 18
        rng.Cells(rng.Rows.Count).Offset(-n + 1).Resize(n).EntireRow.Delete
    End If
Next rng
Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 36

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41740943
And if you want to fill the missing numbers as well, please try this....
Sub InsertRows()
Dim rng As Range
Dim n As Long, lr As Long
Application.ScreenUpdating = False
For Each rng In Range("C:C").SpecialCells(xlCellTypeConstants, 1).Areas
    rng.Cells(rng.Rows.Count).Select
    If rng.Cells(rng.Rows.Count) < 18 Then
        n = 18 - rng.Cells(rng.Rows.Count)
        rng.Cells(rng.Rows.Count + 1).Resize(n).EntireRow.Insert
    ElseIf rng.Cells(rng.Rows.Count) > 18 Then
        n = rng.Cells(rng.Rows.Count) - 18
        rng.Cells(rng.Rows.Count).Offset(-n + 1).Resize(n).EntireRow.Delete
    End If
Next rng
lr = Cells(Rows.Count, 3).End(xlUp).Row
Range("C2:C" & lr).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C+1"
Range("C2:C" & lr).Value = Range("C2:C" & lr).Value
Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 41740952
Sub qa2qa18()
    Dim lqa As Range, uqa As Range, xtrarows As Long
    Set uqa = Range("C:C").Find("QA:", Range("C1"), , xlWhole)
    Set lqa = uqa.Offset(1).Resize(Rows.Count - uqa.Row).Find("QA:", uqa.Offset(1), , xlWhole)
    Do While Not lqa Is Nothing
        xtrarows = lqa.Row - uqa.Row - 19
        Select Case xtrarows
            Case Is = 0
            Case Is > 0
                lqa.Offset(-xtrarows).Resize(xtrarows).EntireRow.Select
                Selection.Delete
            Case Is < 0
                lqa.Resize(-xtrarows).EntireRow.Select
                Selection.Insert
        End Select
        Set uqa = lqa
        Set lqa = uqa.Offset(1).Resize(Rows.Count - uqa.Row).Find("QA:", uqa.Offset(1), , xlWhole)
    Loop
End Sub
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 

Author Comment

by:W.E.B
ID: 41740969
Hi Subodh,
I'm getting error when trying the code.
Please sample atatched.
Note, the sequencing  I put on the original sample, was just to show the numbers of rows, (it wasn't meant to be there), sometimes I have data , some times empty cells in between QA:

Hi Saqib,
Your code is working, but, if I have QA: on consecutive rows, it doesn't add 18 rows in between.

Thank you.
Sample2.xlsx
0
 
LVL 43

Accepted Solution

by:
Saqib Husain, Syed earned 2000 total points
ID: 41741034
Sub qa2qa18()
    Dim lqa As Range, uqa As Range, xtrarows As Long
    Set uqa = Range("C:C").Find("QA:", Range("C1"), , xlWhole)
    Set lqa = uqa.Resize(Rows.Count - uqa.Row - 1).Find("QA:", uqa, , xlWhole)
    Do While lqa.Row <> uqa.Row
        xtrarows = lqa.Row - uqa.Row - 19
        Select Case xtrarows
            Case Is = 0
            Case Is > 0
                lqa.Offset(-xtrarows).Resize(xtrarows).EntireRow.Select
                Selection.Delete
            Case Is < 0
                lqa.Resize(-xtrarows).EntireRow.Select
                Selection.Insert
        End Select
        Set uqa = lqa
        Set lqa = uqa.Resize(Rows.Count - uqa.Row - 1).Find("QA:", uqa, , xlWhole)
    Loop
End Sub
0
 

Author Closing Comment

by:W.E.B
ID: 41741061
Thank you very much.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

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.

Join & Write a Comment

With the emergence of Office 365 as a superior email communication platform, many organizations have started switching over to it.  After migrating to Office 365, sometimes users, as well as organizations, will have to import PST files to Office 36…
Excel allows various different methods to link Excel files to each other. This includes relative paths, mapped drives (or the local drive) and UNC paths. UNC paths are the least robust of the three.
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…
Enter Foreign and Special Characters Enter characters you can't find on a keyboard using its ASCII code ... and learn how to make a handy reference for yourself using Excel ~ Use these codes in any Windows application! ... whether it is a Micr…

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