Sheets.Add Function

[FrankTimJr]

Is there any way to tell a macro that when a new sheet is added what the
sheet name is instaed of having Excel just give it the next "sheet1"? Other
functions in the macro reference the newly created tab and I'll never be able
to ensure it is ALWAYS "sheet1" before running the macro. I would like to
have the macro automatically give it a name I designate.

"Sheets.Add" is the function.

Any ideas??
Frank

 

[Jim Thomlinson]

Give this a try...

Sub test()
Dim wksNew As Worksheet

Set wksNew = Worksheets.Add
wksNew.Name = "Whatever"

MsgBox wksNew.Name
MsgBox Sheets("Whatever").Name
End Sub

Note that I create a worksheet object and reference the new sheet to that
object. That way I can reference the new sheet directly by just referencing
wksNew instead of referencing it indirectly by referening the worksheet that
has the tab name "Whatever"...

 

[Chip Pearson]

Put the following code in the ThisWorkbook code module (it must be in that
module in order to be called by Excel).

'''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim NewName As String
NewName = "Something"
If SheetNameExists(NewName) = False Then
Sh.Name = NewName
Else
'''''''''''''''''''''''''''''''''
' Appropriate action if NewName
' already exists goes here.
'''''''''''''''''''''''''''''''''
End If
End Sub

Private Function SheetNameExists(S As String) As Boolean
On Error Resume Next
SheetNameExists = CBool(Len(Me.Worksheets(S).Name))
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''

When a new worksheet is created, the Workbook_NewSheet event procedure is
called automatically by Excel, which passes in the Sh parameter referencing
the newly created sheet. The code above names the new worksheet "Something"
if that name is not already in use.

See http://www.cpearson.com/Excel/Events.aspx for more information about
event procedures.

--
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2008
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[FrankTimJr]

Thank you!!!

Give this a try...

Sub test()
Dim wksNew As Worksheet

Set wksNew = Worksheets.Add
wksNew.Name = "Whatever"

MsgBox wksNew.Name
MsgBox Sheets("Whatever").Name
End Sub

Note that I create a worksheet object and reference the new sheet to that
object. That way I can reference the new sheet directly by just referencing
wksNew instead of referencing it indirectly by referening the worksheet that
has the tab name "Whatever"...

 

[RB Smissaert]

I know it is a lot of code, but you may find it useful:


Function AddSheet(ByVal strSheet As String, _
ByVal bOverwrite As Boolean, _
ByVal lLocation As Long, _
Optional ByVal bClear As Boolean = True, _
Optional ByVal bActivate As Boolean = True, _
Optional bSetScreenUpdating As Boolean = True, _
Optional strCallingProc As String) As String

'strSheet, name of the new sheet
'bOverWrite, clear existing sheet and don't use new sheet if TRUE
'lLocation,
'1 new sheet will be first one in the WB
'2 new sheet will be before active sheet
'3 new sheet will be after active sheet
'4 new sheet will be last one in the WB
'if bClear = True it will clear the cells of an existing sheet
'will return the name of the newly added sheet
'-----------------------------------------------------------------

Dim i As Long
Dim bFound As Boolean
Dim objNewSheet As Worksheet
Dim objSheet As Worksheet
Dim strOldSheet As String
Dim strSuppliedSheetName As String
Dim lLastNumber As Long

If bSetScreenUpdating Then
Application.ScreenUpdating = False
End If

strSheet = ClearCharsFromString(strSheet, "*:?/\[]")

If bActivate = False Then
strOldSheet = ActiveSheet.Name
End If

strSuppliedSheetName = strSheet

'see if the sheet already exists
'-------------------------------
For i = 1 To ActiveWorkbook.Sheets.Count
If UCase(Sheets(i).Name) = UCase(strSheet) Then
bFound = True
If bOverwrite Then
'no new sheet to add
'-------------------
Sheets(i).Activate
'otherwise there will be an error at the line
'Cells.Clear when a chart is activated
'--------------------------------------------
Sheets(i).Cells(1).Activate
If bClear Then
Cells.Clear
End If
AddSheet = strSheet
If bActivate = False Then
Sheets(strOldSheet).Activate
End If
If bSetScreenUpdating Then
Application.ScreenUpdating = True
End If
Exit Function
End If
End If
Next i

For Each objSheet In ActiveWorkbook.Worksheets
If objSheet.Name = strSheet Then
bFound = True
Exit For
End If
Next objSheet

'sheet not in WB yet, or bOverWrite = FALSE, so add
'--------------------------------------------------
Select Case lLocation
Case 1
Set objNewSheet =
ActiveWorkbook.Sheets.Add(Before:=ActiveWorkbook.Sheets(1))
Case 2
Set objNewSheet = ActiveWorkbook.Sheets.Add 'will be before
active sheet
Case 3
Set objNewSheet = ActiveWorkbook.Sheets.Add(After:=ActiveSheet)
Case 4
Set objNewSheet =
ActiveWorkbook.Sheets.Add(After:=Sheets(ActiveWorkbook.Sheets.Count))
End Select

'activate and name it
'--------------------
objNewSheet.Activate

'truncate if sheet name is too long
'----------------------------------
If Len(strSheet) > 27 Then
strSheet = Left$(strSheet, 27) & "_" & 1
i = 1
Do While SheetExists(Left$(strSheet, 27) & "_" & i) = True
i = i + 1
strSheet = Left$(strSheet, 27) & "_" & i
Loop
End If

If bFound = False Then
ActiveSheet.Name = strSheet
AddSheet = strSheet
Else
If IsNumeric(Right$(strSheet, 1)) Then
Do While SheetExists(strSheet) = True
lLastNumber = Val(GetLastNumberFromString(strSheet, "."))
strSheet = Left$(strSheet, Len(strSheet) - Len(CStr(lLastNumber))) &
_
lLastNumber + 1
Loop
ActiveSheet.Name = strSheet
AddSheet = strSheet
Else
i = 2
Do Until SheetExists(strSheet & "_" & i) = False
i = i + 1
Loop
ActiveSheet.Name = strSheet & "_" & i
AddSheet = strSheet & "_" & i
End If
End If

If bActivate = False Then
Sheets(strOldSheet).Activate
End If

If bSetScreenUpdating Then
Application.ScreenUpdating = True
End If

End Function

Function ClearCharsFromString(strString As String, _
strChars As String, _
Optional bAll As Boolean = True, _
Optional bLeading As Boolean, _
Optional bTrailing As Boolean) As String

Dim i As Long
Dim strChar As String

ClearCharsFromString = strString

If bAll Then
For i = 1 To Len(strChars)
strChar = Mid$(strChars, i, 1)
If InStr(1, strString, strChar) > 0 Then
ClearCharsFromString = Replace(ClearCharsFromString, _
strChar, _
vbNullString, _
1, -1, vbBinaryCompare)
End If
Next i
Else
If bLeading Then
Do While InStr(1, strChars, Left$(ClearCharsFromString, 1), _
vbBinaryCompare) > 0
ClearCharsFromString = Right$(ClearCharsFromString, _
Len(ClearCharsFromString) - 1)
Loop
End If
If bTrailing Then
Do While InStr(1, strChars, Right$(ClearCharsFromString, 1), _
vbBinaryCompare) > 0
ClearCharsFromString = Left$(ClearCharsFromString, _
Len(ClearCharsFromString) - 1)
Loop
End If
End If

End Function

Function SheetExists(ByVal strSheetName As String) As Boolean

'returns True if the sheet exists in the active workbook
'-------------------------------------------------------

Dim x As Object

On Error Resume Next
Set x = ActiveWorkbook.Sheets(strSheetName)

If Err = 0 Then
SheetExists = True
Else
SheetExists = False
End If

End Function

Public Function GetLastNumberFromString(strString As String, _
strSeparator As String) As String

Dim btBytes() As Byte
Dim btSeparator() As Byte
Dim i As Long
Dim c As Long
Dim lLast As Long
Dim lFirst As Long
Dim bFoundDot As Boolean
Dim strNumber As String

btBytes() = strString
btSeparator() = strSeparator

'find the last numeric character
For i = UBound(btBytes) - 1 To 0 Step -2
If btBytes(i) > 47 And btBytes(i) < 58 Then
lLast = i
'find the first numeric character
For c = lLast - 2 To 0 Step -2
If btBytes(c) > 57 Or _
(btBytes(c) < 48 And _
btBytes(c) <> btSeparator(0)) Then
'non-numeric and no separator, so get out
lFirst = c + 2
GoTo GETOUT
End If
If btBytes(c) = btSeparator(0) Then
If bFoundDot = False Then
'first separator, so search for more numbers
bFoundDot = True
Else
'second separator, so get out
lFirst = c + 2
GoTo GETOUT
End If
End If
Next
End If
Next

GETOUT:

'build up the numeric string
For i = lFirst \ 2 + 1 To lLast \ 2 + 1
strNumber = strNumber & Mid$(strString, i, 1)
Next

'add trailing zero if first character is separator
If Left$(strNumber, 1) = strSeparator Then
strNumber = "0" & strNumber
End If

GetLastNumberFromString = strNumber

End Function


RBS