PDA

View Full Version : Delete button added to new row and delete row/move sheet.



tyroneclark
03-01-2019, 04:02 AM
I have built out the code below for a button which adds a new row and sheet with the respective name, input by user. Now I need to get a delete button per row added - every variation ive looked at doesnt apply to what im trying to do so was hoping for a bit of guidance...

AIM: When a new row is added and the sheet created, as in the code below; I want a DELETE button added to each new row, when this is pressed, ask for confirmation from the user and then delete that row and move the associated sheet to a different workbook (WorkBook_Archive.xlsm) with the date included prior to the original sheet name (gives a unique identifier).



Private Sub NewServer_Click()
Dim shtName As String, ws As Worksheet
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wsGENERAL As Worksheet
Dim shNAMES As Range, nmANCHOR As Range
Dim eRow As Long, wasVISIBLE As Boolean
Dim shANCHOR As Range
'Get name for new sheet
With ThisWorkbook
Set wsMASTER = .Sheets("Main")
Set wsTEMP = .Sheets("ServerTemplate")
Set nmANCHOR = wsMASTER.Range("E10:E" & Rows.Count).End(xlUp).Offset(1)
'set ServerTemplate to visible
wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)
If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible
'Turn off updates, alerts and events
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
'prompt for user to enter new server name
wsMASTER.Unprotect Password:="J786djh$"
Do
wsMASTER.Activate
shtName = Application.InputBox("Please Enter Name For New Server" & vbCrLf & vbCrLf & _
"Click Cancel To Quit", "Define Sheet Name", Type:=2)
If shtName = "False" Then Exit Sub
'Check for existing sheet name
Set ws = Nothing
On Error Resume Next
'set variable to input name
Set ws = Sheets(shtName)
On Error GoTo 0
If ws Is Nothing Then Exit Do
'incorrect input alert
MsgBox "Please try again, ensuring no spaces are used in the new server name.", vbExclamation, "Name Exists"
Loop

'add new row with input value
eRow = wsMASTER.Range("E" & Rows.Count).End(xlUp).Row + 1
wsMASTER.Cells(eRow, "E").Value = shtName
'add worksheet and rename it
wsTEMP.Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = shtName
'Create hyperlink
Set shANCHOR = wsMASTER.Range("E" & Rows.Count).End(xlUp)
wsMASTER.Hyperlinks.Add anchor:=shANCHOR, Address:="", SubAddress:="'" & shtName & "'!A1", TextToDisplay:=shtName
'delete any copies of the Server Template
For Each wsGENERAL In ThisWorkbook.Worksheets
If wsGENERAL.Name = "ServerTemplate(1)" Then
wsGENERAL.Delete
End If
Next wsGENERAL
'back to Main Sheet
wsMASTER.Activate
're-enable screen updating
'Turn off updates, alerts and events
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
wsMASTER.Protect Password:="J786djh$"
End With
'set ServerTemplate to hidden
If wasVISIBLE Then wsTEMP.Visible = xlSheetHidden Else: If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden


End Sub