Solved

vba- Insert Raws in excel

Posted on 2016-08-03
6
61 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 29

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 29

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
ScreenConnect 6.0 Free Trial

Discover new time-saving features in one game-changing release, ScreenConnect 6.0, based on partner feedback. New features include a redesigned UI, app configurations and chat acknowledgement to improve customer engagement!

 

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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

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

In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
Outlook Free & Paid Tools
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 …
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

831 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