renaming tabs based on a on a worksheet

  • Thread starter Thread starter webels
  • Start date Start date
W

webels

HI
This is a piece of code written by Dave Peterson, it works perfect for
my needs.

Option Explicit
Sub testme01()
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
With wks
On Error Resume Next
..Name = .Range("b4").Text
If Err.Number <> 0 Then
MsgBox .Name & " was not renamed"
Err.Clear
End If
On Error GoTo 0
End With
Next wks
End Sub



However what I would like to also do would be to delete a worksheet if
the is no value in cell b4.

Many thanks for any suggestions.

Thanks
Eddie
 
Hi
You can change your sub to this. Displayalerts suppresses the "are you
sure?" message when the sheet is deleted. The Trim command is there
incase your B4 cell has a space or other none printing character in
it.
I took the On Error code out of the loop too - no need to call it each
time.
regards
Paul

Option Explicit
Sub testme02()
Dim wks As Worksheet
On Error Resume Next
For Each wks In ActiveWorkbook.Worksheets
With wks
If Trim(.Range("b4").Text) = "" Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
Else
.Name = .Range("b4").Text
If Err.Number <> 0 Then
MsgBox .Name & " was not renamed"
Err.Clear
End If
End If
End With
Next wks
On Error GoTo 0
End Sub
 
Hi
You can change your sub to this. Displayalerts suppresses the "are you
sure?" message when the sheet is deleted. The Trim command is there
incase your B4 cell has a space or other none printing character in
it.
I took the On Error code out of the loop too - no need to call it each
time.
regards
Paul

Option Explicit
Sub testme02()
Dim wks As Worksheet
On Error Resume Next
For Each wks In ActiveWorkbook.Worksheets
With wks
If Trim(.Range("b4").Text) = "" Then
Application.DisplayAlerts = False
    .Delete
Application.DisplayAlerts = True
Else
    .Name = .Range("b4").Text
  If Err.Number <> 0 Then
    MsgBox .Name & " was not renamed"
    Err.Clear
  End If
End If
End With
Next wks
On Error GoTo 0
End Sub
Click to expand...

Very neat Paul
Works a treat
Thanks
 
Back
Top