We help IT Professionals succeed at work.

VBA to delete rows

Attached is a spreadsheet containing a sub routine that inserts a given number of rows on the selected worksheets (worksheets are selected in the code).

Upon clicking the "Click to Insert" button, you will receive a dialog box that will allow you to input the number of rows you wish to insert.  I'd like to modify this module so that when a negative value is entered, it will delete rows as opposed to inserting.

Any suggestions?
Example-Code.xlsm
Comment
Watch Question

Hi

Try


Kris
Public Sub process()
    
    Dim MyList As String
    Dim arr As Variant
    Dim arrZones As Variant
    Dim ws As Worksheet
    Dim rng As String
    Dim start As Range
    Dim sel As Integer
    Dim n As Integer
    
    
    '-- determine required number of rows
    rng = InputBox("Enter number of rows required." & vbCrLf & vbCrLf & "All formulas and formatting in row above current position of cursor will be copied.")
    If rng = "" Then Exit Sub
    
    '-- generate list of worksheets to process
    MyList = "Summary,Details"
    For Each ws In ThisWorkbook.Worksheets
        If LCase(ws.Name) Like "zone*" Then
            MyList = MyList & IIf(Len(MyList) = 0, "", ",") & ws.Name
        End If
    Next
    arr = Split(MyList, ",")
    
    ' first add the rows to the zones sheets
    sel = Selection.Row
    Set start = Selection
    
    ' select all required sheets as a group, then do the insert
    ThisWorkbook.Worksheets(arr).Select
    
    If CInt(rng) > 0 Then
        ActiveSheet.Rows(sel).Resize(rng, 1).EntireRow.Insert
        
        ActiveSheet.Select
        '-- perform the insert on selected worksheets
        For Each ws In Worksheets(arr)
            '-- insert formulae
            ws.Cells(sel - 1, 1).Resize(rng + 1, 1).EntireRow.FillDown
        Next ws
    ElseIf CInt(rng) < 0 Then
        ActiveSheet.Rows(sel).Resize(Abs(CInt(rng)), 1).EntireRow.Delete
    End If
    
End Sub

Open in new window

dsackerContract ERP Admin/Consultant
CERTIFIED EXPERT

Commented:
I looked at your spreadsheet. There may be a few other places you need to deal with deleting rows, but it will start with changing your Selection.Insert to the following:
    If rng > 0 Then
        Selection.Insert
    Else
        If rng < 0 Then
            Selection.Delete
        End If
    End If

Open in new window

Like I said, you may need to deal with the line that says: ws.Cells(sel - 1, 1).Resize(Abs(rng) + 1, 1).EntireRow.FillDown

Notice I added the ABS function.
Top Expert 2011
Commented:
I think you'll need to do it like this to ensure that you don't lose the 3d range reference on the summary sheet:
Public Sub process()
Dim MyList As String
Dim arr As Variant
Dim arrZones As Variant
Dim ws As Worksheet
Dim strRng As String
Dim rng As Integer
Dim start As Range
Dim sel As Integer
Dim n As Integer
    
    
    '-- determine required number of rows
    strRng = InputBox("Enter number of rows required." & vbCrLf & vbCrLf & "All formulas and formatting in row above current position of cursor will be copied.")
    If strRng = "" Then Exit Sub
    
    If IsNumeric(strRng) Then
        rng = CInt(strRng)
    Else
        Exit Sub
    End If
    
    '-- generate list of worksheets to process
    MyList = "Summary,Details"
    For Each ws In ThisWorkbook.Worksheets
        If LCase(ws.Name) Like "zone*" Then
            MyList = MyList & IIf(Len(MyList) = 0, "", ",") & ws.Name
        End If
    Next
    arr = Split(MyList, ",")
    
    ' first add the rows to the zones sheets
    sel = Selection.Row
    Set start = Selection
    
    ' select all required sheets as a group, then do the insert
    ThisWorkbook.Worksheets(arr).Select
    
    
    If rng > 0 Then
        ActiveSheet.Rows(sel).Resize(rng, 1).EntireRow.Select
        Selection.Insert
        
        ActiveSheet.Select
        '-- perform the insert on selected worksheets
        For Each ws In Worksheets(arr)
            '-- insert formulae
            ws.Cells(sel - 1, 1).Resize(rng + 1, 1).EntireRow.FillDown
        Next ws
    Else
        If rng < 0 Then
            ActiveSheet.Rows(sel).Resize(Abs(rng), 1).EntireRow.Select
            Selection.Delete
        End If
    End If
    
End Sub

Open in new window

Author

Commented:
I'm going to go with Andrews solution.  It accomplishes what I need.  Thanks for your help!

kp
Hi

BTW, is there anything new in Andrews' solution as compared to my reply ?

Author

Commented:
Kris, my apologies.  After looking at your recommendation, it appears to have accomplished the exact same thing.  This difference between your recommendation and Andrew's is very minimal.  Sorry, I should I awarded you the points since you responded first.  When I saw a slight difference, I defaulted to Andrew's since I borrowed the code from a different thread he provided a solution to.


No worries :)

Author

Commented:
Thank you.  I submitted the request to reopen anyways.  As an FYI, I posted a separate question that uses this code if you're interested in checking it out.  
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27426194.html
Top Expert 2011

Commented:
The reason I posted here was in my test @krishnakrkc's code did not delete the rows from all selected worksheets, which I believed was a requirement, and does not adjust the 3d range formual on the summary sheet.  I wasn't trying to duplicate what he had done.  The key difference is the explcit Select in the delete part of the code.

I don't think the select is required to delete the rows.
Top Expert 2011

Commented:
It shouldn't be but it is required when a group of sheets is selected like this.  Try it - your code does not delete rows from all the grouped worksheets, only the first one.  I'm not worrying about points here - I'm happy if @KP_SoCal want to reallocate, I was just pointing out that my solution was distinct,

fair enough :)

Explore More ContentExplore courses, solutions, and other research materials related to this topic.