Add or remove a selection of rows with a button

suxrule

New Member
Joined
Mar 2, 2021
Messages
14
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
Hi,

My ask seems very complicated as it look like it will need VBA knowledge of which I have none, so please just tell me it's too complicated for someone like me and I'll leave it.

I want to add and delete a selection of rows with a + or - button of some sorts but it will always need to be inserted above a certain cell as that cell will have a total in it.

I've attached a screen shot of the rows I'd like to duplicate or remove, will any formulas automatically adjust if I ever get it working?

Here's a copy of the actual spreadsheet (can't get the mini sheet add-on working) - Actual Spreadsheet

Any help much appreciated.

Add Remove Idea.png
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Hello Suxrule,
try to add new set of rows with this code.
VBA Code:
Sub AddMultipleRows()

    Dim vNR As Long
    
    vNR = Cells(Rows.Count, 1).End(xlUp).Row
    Rows(vNR + 2 & ":" & vNR + 5).Insert
    Range(Cells(vNR - 2, 1), Cells(vNR + 1, 32)).Copy _
        Range("A" & vNR + 2)
    Range(Cells(vNR + 4, 2), Cells(vNR + 4, 28)).ClearContents
    Range("A" & vNR + 4 & ":A" & vNR + 5).ClearContents
    Cells(vNR + 5, 31).ClearContents
    Cells(vNR + 9, 30).Formula = "=sum(" & "AD5:AD" & vNR + 5 & ")"
    Cells(vNR + 9, 31).Formula = "=sum(" & "AE5:AE" & vNR + 5 & ")"
    Cells(vNR + 9, 32).Formula = "=sum(" & "AF5:AF" & vNR + 5 & ")"
    
End Sub

And to remove last set of rows with this code.
VBA Code:
Sub RemoveLastMultipleRows()

    Dim vNR As Long
    
    vNR = Cells(Rows.Count, 1).End(xlUp).Row
    Range(Cells(vNR - 2, 1), Cells(vNR + 1, 32)).Delete
    
End Sub
 
Upvote 0
Hi,

Sorry for the late reply.

Thanks so much thats almost exactly what I needed, honestly really grateful for your time.

It adds the exact set of rows I'm needing perfectly when attached to a button but the only problem (and it could definitely be something at my end) is that when I use the code to push the button to remove the set of rows it deletes the set of rows with names in the 'A' column first until the newly added blank rows are left and then I'm met with the attached error message when I press the 'remove' button, when trying to remove them.

What I'd like to achieve is the removal of the last added set of rows if possible.

As a side note it also seems to be adding the 'hours this week' columns up the way instead of along.

Again I've attached the full spreadsheet in case you want to take a look and maybe see if I've done something wrong - SPREADSHEET LINK

Any help appreciated.

What will delete.png


Error
When blank.png
 
Upvote 0
Code looks for last name in the column "A".
I assumed that field with name in column "A" will not be empty before deleting rows.
If this field is empty it causes error. Now will look for last row with "Start" in column "B".
Set all formulas in column "AD" to look like this "=SUM(B7:AB7)" and try to remove set of rows with this code...
VBA Code:
Sub AddMultipleRows()

    Dim vR As Range
    
    Set vR = ActiveSheet.Columns(2).Find _
        ("Start", Cells(Rows.Count, 2), , , , xlPrevious)
    Rows(vR.Row + 3 & ":" & vR.Row + 6).Insert
    Range(Cells(vR.Row - 1, 1), Cells(vR.Row + 2, 32)).Copy _
        Range("A" & vR.Row + 3)
    Range(Cells(vR.Row + 5, 2), Cells(vR.Row + 5, 28)).ClearContents
    Range("A" & vR.Row + 5 & ":A" & vR.Row + 6).ClearContents
    Cells(vR.Row + 6, 31).ClearContents
    Cells(vR.Row + 10, 30).Formula = "=sum(" & "AD5:AD" & vR.Row + 6 & ")"
    Cells(vR.Row + 10, 31).Formula = "=sum(" & "AE5:AE" & vR.Row + 6 & ")"
    Cells(vR.Row + 10, 32).Formula = "=sum(" & "AF5:AF" & vR.Row + 6 & ")"
    
End Sub


Sub RemoveLastMultipleRows2()

    Dim vR As Range
    
    Set vR = ActiveSheet.Columns(2).Find _
        ("Start", Cells(Rows.Count, 2), , , , xlPrevious)
    Range(Cells(vR.Row - 1, 1), Cells(vR.Row + 2, 32)).Delete
    
End Sub
 
Upvote 0
Solution
That seems to of fixed and do everything that I would like it to do, honestly can't thank you enough. Blows my mind that people know how to do this sort of stuff with excel. Thanks again.

As one last side note, is there a way of ensuring the can't delete the last set of rows as if they accidentally it remove too many times then there is nothing to add back in if that makes sense?
 
Upvote 0
In addition to my last question...is there anyway to get it to work if If I protect the sheet?

I've tried selecting and unselecting various options in the 'allow users' tab but keep getting a 'Microsoft Visual Basic 400" error.

Sorry seems like I'm incapable of figuring this out by my self.
 
Upvote 0
When you make changes in the sheet with VBA it's not easy to do "Undo".
You need to do special procedure depending of type of changes.
In your case, I suggest to make copy of data on hidden sheet before first click on "Remove" button.
Also create new button "Undo" with procedure to recall data from hidden sheet.
If you want to run code on proceted sheet you need to unprotect sheet before exacuting code,
and if you need, at the end protect sheet again.
Here is example for remove button procedure.
Before run, set password in the code as in your sheet.
VBA Code:
Sub RemoveLastMultipleRows2()

    Dim vR As Range
    
    Set vR = ActiveSheet.Columns(2).Find _
        ("Start", Cells(Rows.Count, 2), , , , xlPrevious)
    Range(Cells(vR.Row - 1, 1), Cells(vR.Row + 2, 32)).Delete
    
End Sub

Sub UnprotectSheet()
   
    ActiveSheet.Unprotect "YourPassword"
   
End Sub

Sub ProtectSheet()

    ActiveSheet.Protect Password:="YourPassword", _
        DrawingObjects:=True, Contents:=True, Scenarios:=True
   
End Sub
 
Upvote 0
Sorry, I forgot to add this procedures to the code.
VBA Code:
Sub RemoveLastMultipleRows2()

    Dim vR As Range
   
    UnprotectSheet
    Set vR = ActiveSheet.Columns(2).Find _
        ("Start", Cells(Rows.Count, 2), , , , xlPrevious)
    Range(Cells(vR.Row - 1, 1), Cells(vR.Row + 2, 32)).Delete
    ProtectSheet

End Sub
 
Upvote 0
Really appreciate your time, everything works perfectly. Is there a way to have a "Are you sure you want to remove this college?" question pop up when they hit the "remove colleague" button?

My hope is by ensuring they don't accidentally delete the last set of rows I won't need to hide them in a hidden sheet as I feel that would be tricky to reinsert the rows from the hidden sheet back in at the desired location...or is that easy enough?

If I wanted to pull the cells from the 'HIDDEN' sheet, even when blank, and reinsert them back in at the highlighted row bellow, is there a simple way to do this or should I just go with the "Are you sure you want to remove this college?" question (if even possible?)

Either way everything you've done for me works perfectly and I'm just pushing my luck now so please don't worry if you've had enough of my questions and asks and you'd rather just leave it at that. Thanks


Rows to reinsert.png


Where to reinsert.png
 
Upvote 0
If you work with very important data it's recommended to create data backup before deleting.
I suppose that your data is not this type and message box will be enough.
You can add in hidden sheet deleted rows as history .
If you need to see deleted data you can unhide sheet and look all deleted data by date and time deleting.

VBA Code:
Private Sub Workbook_Open()

    Sheets("HIDDEN").Visible = 2

End Sub

Sub RemoveLastMultipleRows3()

    Dim vR As Range, vR2 As Range
    Dim vRow As Long
    Dim vMsgBox As String
    
    Set vR = Sheets("Test").Columns(2).Find _
            ("Start", Cells(Rows.Count, 2), , , , xlPrevious)
    If vR Is Nothing Then
        MsgBox "Nothing to delete"
        Exit Sub
    End If
    vMsgBox = MsgBox("Are you sure you want to remove this college?", _
       vbYesNo, "Confirm deleting")
    If vMsgBox = 6 Then
        Set vR2 = Sheets("HIDDEN").Columns(3).Find _
            ("Start", Cells(Rows.Count, 3), , , , xlPrevious)
        If vR2 Is Nothing Then
            vRow = 1
        Else
            vRow = vR2.Row + 4
        End If
        Sheets("Test").Range(Sheets("Test").Cells(vR.Row - 1, 1), _
            Sheets("Test").Cells(vR.Row + 2, 32)).Copy _
            Sheets("HIDDEN").Range(Sheets("HIDDEN").Cells(vRow, 2), _
            Sheets("HIDDEN").Cells(vRow, 32))
        Sheets("HIDDEN").Range("A" & vRow + 1) = Now
        Sheets("HIDDEN").Columns(1).ColumnWidth = 15
        UnprotectSheet
        Range(Cells(vR.Row - 1, 1), Cells(vR.Row + 2, 32)).Delete
        ProtectSheet
    End If

End Sub

Sub UnhideHistory()

    Sheets("HIDDEN").Visible = -1
    Sheets("HIDDEN").Activate
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,136
Members
448,551
Latest member
Sienna de Souza

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top