tyroneclark
New Member
- Joined
- Sep 7, 2015
- Messages
- 6
Hi all,
Trying to do something I havent tried before and no idea where to start.
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).
Thanks for any help you can provide, I am assuming the position of the button matters, for the purposes here, the button will be in Column F starting at row 10.
Thanks again!
Ty
Trying to do something I havent tried before and no idea where to start.
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).
Code:
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
With ThisWorkbook
Set wsMASTER = .Sheets("Main")
Set wsTEMP = .Sheets("ServerTemplate")
Set nmANCHOR = wsMASTER.Range("E10:E" & Rows.Count).End(xlUp).Offset(1)
wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)
If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
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
Set ws = Nothing
On Error Resume Next
Set ws = Sheets(shtName)
On Error GoTo 0
If ws Is Nothing Then Exit Do
MsgBox "Please try again, ensuring no spaces are used in the new server name.", vbExclamation, "Name Exists"
Loop
eRow = wsMASTER.Range("E" & Rows.Count).End(xlUp).Row + 1
wsMASTER.Cells(eRow, "E").Value = shtName
wsTEMP.Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = shtName
Set shANCHOR = wsMASTER.Range("E" & Rows.Count).End(xlUp)
wsMASTER.Hyperlinks.Add anchor:=shANCHOR, Address:="", SubAddress:="'" & shtName & "'!A1", TextToDisplay:=shtName
For Each wsGENERAL In ThisWorkbook.Worksheets
If wsGENERAL.Name = "ServerTemplate(1)" Then
wsGENERAL.Delete
End If
Next wsGENERAL
wsMASTER.Activate
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
wsMASTER.Protect Password:="J786djh$"
End With
If wasVISIBLE Then wsTEMP.Visible = xlSheetHidden Else: If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden
End Sub
Thanks for any help you can provide, I am assuming the position of the button matters, for the purposes here, the button will be in Column F starting at row 10.
Thanks again!
Ty