Solved

vba- Insert Raws in excel

Posted on 2016-08-03
6
43 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:Wass_QA
  • 2
  • 2
  • 2
6 Comments
 
LVL 28

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 28

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
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:Wass_QA
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:Wass_QA
ID: 41741061
Thank you very much.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
My experience with Windows 10 over a one year period and suggestions for smooth operation
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
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…

744 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now