Solved

vba- Insert Raws in excel

Posted on 2016-08-03
6
68 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
  • 2
6 Comments
 
LVL 31

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 31

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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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

Increase your protection from Zero Day threats!

Running two Antivirus' is never a good idea.
Taking advantage of Multiple Security layers on the other hand can often save your hide.
See which top notch security software brands have been proven to happily coexist together.
Reduce your chances of becoming a statistic.

Question has a verified solution.

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

Suggested Solutions

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …

752 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