Add sheet and name it unless it already exists

[Howard]

With a list of names in column A, this code will add a sheet and name it from that list.

If I add a few names to the list, how can I ignore the names with sheets already named from the list and add sheets for the new names?
And keep the entire list intact.

Thanks,
Howard

Option Explicit
Sub SheetsAhoy()
Dim MySnme As Range
Dim c As Range
Set MySnme = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each c In MySnme
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
Next
End Sub

 

[Claus Busch]

Hi Howard,

Am Fri, 10 May 2013 06:00:54 -0700 (PDT) schrieb Howard:

With a list of names in column A, this code will add a sheet and name it from that list.

If I add a few names to the list, how can I ignore the names with sheets already named from the list and add sheets for the new names?
And keep the entire list intact.

try:

Function SheetExists(strShName As String) As Boolean
On Error Resume Next
SheetExists = Not Sheets(strShName) Is Nothing
End Function

Sub SheetsAhoy()
Dim MySnme As Range
Dim c As Range

Set MySnme = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each c In MySnme
If Not SheetExists(c.Text) Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = c
End If
Next
End Sub


Regards
Claus Busch

 

[Howard]

Hi Howard,



Am Fri, 10 May 2013 06:00:54 -0700 (PDT) schrieb Howard:







try:



Function SheetExists(strShName As String) As Boolean

On Error Resume Next

SheetExists = Not Sheets(strShName) Is Nothing

End Function



Sub SheetsAhoy()

Dim MySnme As Range

Dim c As Range



Set MySnme = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

For Each c In MySnme

If Not SheetExists(c.Text) Then

Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = c

End If

Next

End Sub





Regards

Claus Busch

Thanks Claus.

I ran it in the sheet module, and is just fine.

Then I thought, wait, don't functions have to be in a standard module?

Is there some rule-of-thumb on when a function MUST be in a standard module?

And to be clear I am under the impression a "standard module" is the one you produce from the vb editor drop down Insert, and is listed as 1, 2, 3 etc. at the bottom of the sheet tree diagram.

Howard

 

[Howard]

You may find this code 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



AGAIN:



10 On Error GoTo ERROROUT



20 If bSetScreenUpdating Then

30 Application.ScreenUpdating = False

40 End If



50 HaveOpenActiveWorkbook



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



70 If bActivate = False Then

80 strOldSheet = ActiveSheet.Name

90 End If



100 strSuppliedSheetName = strSheet



'see if the sheet already exists

'-------------------------------

110 For i = 1 To ActiveWorkbook.Sheets.Count

120 If UCase(Sheets(i).Name) = UCase(strSheet) Then

130 bFound = True

140 If bOverwrite Then

'no new sheet to add

'-------------------

150 Sheets(i).Activate

'otherwise there will be an error at the line

'Cells.Clear when a chart is activated

'--------------------------------------------

160 Sheets(i).Cells(1).Activate

170 If bClear Then

180 Cells.Clear

190 End If

200 AddSheet = strSheet

210 If bActivate = False Then

220 Sheets(strOldSheet).Activate

230 End If

240 If bSetScreenUpdating Then

250 Application.ScreenUpdating = True

260 End If

270 Exit Function

280 End If

290 End If

300 Next i



310 For Each objSheet In ActiveWorkbook.Worksheets

320 If objSheet.Name = strSheet Then

330 bFound = True

340 Exit For

350 End If

360 Next objSheet



'sheet not in WB yet, or bOverWrite = FALSE, so add

'--------------------------------------------------

370 Select Case lLocation

Case 1

380 Set objNewSheet =

ActiveWorkbook.Sheets.Add(Before:=ActiveWorkbook.Sheets(1))

390 Case 2

400 Set objNewSheet = ActiveWorkbook.Sheets.Add 'will be

before active sheet

410 Case 3

420 Set objNewSheet = ActiveWorkbook.Sheets.Add(After:=ActiveSheet)

430 Case 4

440 Set objNewSheet =

ActiveWorkbook.Sheets.Add(After:=Sheets(ActiveWorkbook.Sheets.Count))

450 End Select



'activate and name it

'--------------------

460 objNewSheet.Activate



'truncate if sheet name is too long

'----------------------------------

470 If Len(strSheet) > 27 Then

480 strSheet = Left$(strSheet, 27) & "_" & 1

490 i = 1

500 Do While SheetExists(Left$(strSheet, 27) & "_" & i) = True

510 i = i + 1

520 strSheet = Left$(strSheet, 27) & "_" & i

530 Loop

540 End If



550 If bFound = False Then

560 ActiveSheet.Name = strSheet

570 AddSheet = strSheet

580 Else

590 If StringEndsUnderScoreNumber(strSheet) Then

600 Do While SheetExists(strSheet) = True

610 lLastNumber = Val(GetLastNumberFromString(strSheet, "."))

620 strSheet = Left$(strSheet, Len(strSheet) -

Len(CStr(lLastNumber))) & _

lLastNumber + 1

630 Loop

640 ActiveSheet.Name = strSheet

650 AddSheet = strSheet

660 Else

670 i = 2

680 Do Until SheetExists(strSheet & "_" & i) = False

690 i = i + 1

700 Loop

710 ActiveSheet.Name = strSheet & "_" & i

720 AddSheet = strSheet & "_" & i

730 End If

740 End If



750 If bActivate = False Then

760 Sheets(strOldSheet).Activate

770 End If



780 If bSetScreenUpdating Then

790 Application.ScreenUpdating = True

800 End If



810 Exit Function

ERROROUT:



'this is needed for in case for example the workbook was protected

'-----------------------------------------------------------------

820 If Err.Number = 1004 Then

830 Application.Workbooks.Add

840 GoTo AGAIN

850 End If



860 If bSetScreenUpdating Then

870 Application.ScreenUpdating = True

880 End If



890 WriteErrorLog "Functions1", "AddSheet", Erl, Err, , True



End Function





Function SheetExists(ByVal strSheetName As String) As Boolean

On Error Resume Next

SheetExists = Len(ActiveWorkbook.Sheets(strSheetName).Name)

End Function





Function HaveOpenActiveWorkbook() As Boolean



'-------------------------------------------------

'check for an active open WB (Personal.xls is not)

'and add a workbook if there was none

'will return True if a WB was added

'-------------------------------------------------

Dim strWB As String

Dim dLeftMargin As Double



On Error GoTo ERROROUT



If Application.Workbooks.Count > 1 Then

'or could there be a situation where there is more than one

'workbook and both are not an ActiveWorkbook ??!

'----------------------------------------------------------

Exit Function

End If



If Application.Workbooks.Count = 0 Then

Application.Workbooks.Add

HaveOpenActiveWorkbook = True

Exit Function

End If



'so now we know we have one WB open and need to check if this is

'Personal.xls as in that case we need to add a normal workbook

'----------------------------------------------------------------



'this will give an error if only Personal.xls is open

'----------------------------------------------------

strWB = ActiveWorkbook.Name



'no error, so it was a normal workbook and nil to be done

'--------------------------------------------------------



On Error GoTo ERROROUT2

dLeftMargin = ActiveSheet.PageSetup.LeftMargin

bCanDoPageSetupLeftMargin = True



Exit Function

ERROROUT:



Application.Workbooks.Add

HaveOpenActiveWorkbook = True



ERROROUT2:



End Function

Hi RBS,

I need some school-housin' on what I do to use it.

Howard

 

[RB Smissaert]

They are VBA functions, called from VBA with the appropriate arguments and
will do as the function says.
Not sure now if they can be used as worksheet functions.

RBS

You may find this code 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



AGAIN:



10 On Error GoTo ERROROUT



20 If bSetScreenUpdating Then

30 Application.ScreenUpdating = False

40 End If



50 HaveOpenActiveWorkbook



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



70 If bActivate = False Then

80 strOldSheet = ActiveSheet.Name

90 End If



100 strSuppliedSheetName = strSheet



'see if the sheet already exists

'-------------------------------

110 For i = 1 To ActiveWorkbook.Sheets.Count

120 If UCase(Sheets(i).Name) = UCase(strSheet) Then

130 bFound = True

140 If bOverwrite Then

'no new sheet to add

'-------------------

150 Sheets(i).Activate

'otherwise there will be an error at the line

'Cells.Clear when a chart is activated

'--------------------------------------------

160 Sheets(i).Cells(1).Activate

170 If bClear Then

180 Cells.Clear

190 End If

200 AddSheet = strSheet

210 If bActivate = False Then

220 Sheets(strOldSheet).Activate

230 End If

240 If bSetScreenUpdating Then

250 Application.ScreenUpdating = True

260 End If

270 Exit Function

280 End If

290 End If

300 Next i



310 For Each objSheet In ActiveWorkbook.Worksheets

320 If objSheet.Name = strSheet Then

330 bFound = True

340 Exit For

350 End If

360 Next objSheet



'sheet not in WB yet, or bOverWrite = FALSE, so add

'--------------------------------------------------

370 Select Case lLocation

Case 1

380 Set objNewSheet =

ActiveWorkbook.Sheets.Add(Before:=ActiveWorkbook.Sheets(1))

390 Case 2

400 Set objNewSheet = ActiveWorkbook.Sheets.Add 'will be

before active sheet

410 Case 3

420 Set objNewSheet =
ActiveWorkbook.Sheets.Add(After:=ActiveSheet)

430 Case 4

440 Set objNewSheet =

ActiveWorkbook.Sheets.Add(After:=Sheets(ActiveWorkbook.Sheets.Count))

450 End Select



'activate and name it

'--------------------

460 objNewSheet.Activate



'truncate if sheet name is too long

'----------------------------------

470 If Len(strSheet) > 27 Then

480 strSheet = Left$(strSheet, 27) & "_" & 1

490 i = 1

500 Do While SheetExists(Left$(strSheet, 27) & "_" & i) = True

510 i = i + 1

520 strSheet = Left$(strSheet, 27) & "_" & i

530 Loop

540 End If



550 If bFound = False Then

560 ActiveSheet.Name = strSheet

570 AddSheet = strSheet

580 Else

590 If StringEndsUnderScoreNumber(strSheet) Then

600 Do While SheetExists(strSheet) = True

610 lLastNumber = Val(GetLastNumberFromString(strSheet, "."))

620 strSheet = Left$(strSheet, Len(strSheet) -

Len(CStr(lLastNumber))) & _

lLastNumber + 1

630 Loop

640 ActiveSheet.Name = strSheet

650 AddSheet = strSheet

660 Else

670 i = 2

680 Do Until SheetExists(strSheet & "_" & i) = False

690 i = i + 1

700 Loop

710 ActiveSheet.Name = strSheet & "_" & i

720 AddSheet = strSheet & "_" & i

730 End If

740 End If



750 If bActivate = False Then

760 Sheets(strOldSheet).Activate

770 End If



780 If bSetScreenUpdating Then

790 Application.ScreenUpdating = True

800 End If



810 Exit Function

ERROROUT:



'this is needed for in case for example the workbook was
protected


'-----------------------------------------------------------------

820 If Err.Number = 1004 Then

830 Application.Workbooks.Add

840 GoTo AGAIN

850 End If



860 If bSetScreenUpdating Then

870 Application.ScreenUpdating = True

880 End If



890 WriteErrorLog "Functions1", "AddSheet", Erl, Err, , True



End Function





Function SheetExists(ByVal strSheetName As String) As Boolean

On Error Resume Next

SheetExists = Len(ActiveWorkbook.Sheets(strSheetName).Name)

End Function





Function HaveOpenActiveWorkbook() As Boolean



'-------------------------------------------------

'check for an active open WB (Personal.xls is not)

'and add a workbook if there was none

'will return True if a WB was added

'-------------------------------------------------

Dim strWB As String

Dim dLeftMargin As Double



On Error GoTo ERROROUT



If Application.Workbooks.Count > 1 Then

'or could there be a situation where there is more than one

'workbook and both are not an ActiveWorkbook ??!

'----------------------------------------------------------

Exit Function

End If



If Application.Workbooks.Count = 0 Then

Application.Workbooks.Add

HaveOpenActiveWorkbook = True

Exit Function

End If



'so now we know we have one WB open and need to check if this is

'Personal.xls as in that case we need to add a normal workbook

'----------------------------------------------------------------



'this will give an error if only Personal.xls is open

'----------------------------------------------------

strWB = ActiveWorkbook.Name



'no error, so it was a normal workbook and nil to be done

'--------------------------------------------------------



On Error GoTo ERROROUT2

dLeftMargin = ActiveSheet.PageSetup.LeftMargin

bCanDoPageSetupLeftMargin = True



Exit Function

ERROROUT:



Application.Workbooks.Add

HaveOpenActiveWorkbook = True



ERROROUT2:



End Function

Hi RBS,

I need some school-housin' on what I do to use it.

Howard

 

[joeu2004]

With a list of names in column A, this code will add a sheet
and name it from that list. If I add a few names to the list,
how can I ignore the names with sheets already named from the
list and add sheets for the new names?

Try the following:

Option Explicit

Sub doit()
Dim sh As Range, shlist As Range
Dim nsh As Long
Dim ws As Worksheet

Set shlist = Range("a1", Cells(Rows.Count, "a").End(xlUp))
If Len(shlist(1)) = 0 Then MsgBox "empty list": Exit Sub

Application.ScreenUpdating = False
Set ws = ActiveSheet ' remember original worksheet
On Error Resume Next
nsh = Sheets.Count
For Each sh In shlist
Err.Clear
Sheets(sh.Value).Activate
If Err <> 0 Then
' worksheet does not exist; create it
Err.Clear
Sheets.Add after:=Sheets(nsh)
If Err <> 0 Then MsgBox "too many": GoTo done
nsh = nsh + 1
ActiveSheet.Name = sh
End If
Next

done:
ws.Activate ' return to original worksheet
Application.ScreenUpdating = True
MsgBox "done"
End Sub

 

[Howard]

Try the following:



Option Explicit



Sub doit()

Dim sh As Range, shlist As Range

Dim nsh As Long

Dim ws As Worksheet



Set shlist = Range("a1", Cells(Rows.Count, "a").End(xlUp))

If Len(shlist(1)) = 0 Then MsgBox "empty list": Exit Sub



Application.ScreenUpdating = False

Set ws = ActiveSheet ' remember original worksheet

On Error Resume Next

nsh = Sheets.Count

For Each sh In shlist

Err.Clear

Sheets(sh.Value).Activate

If Err <> 0 Then

' worksheet does not exist; create it

Err.Clear

Sheets.Add after:=Sheets(nsh)

If Err <> 0 Then MsgBox "too many": GoTo done

nsh = nsh + 1

ActiveSheet.Name = sh

End If

Next



done:

ws.Activate ' return to original worksheet

Application.ScreenUpdating = True

MsgBox "done"

End Sub

Hi joeu2004,

Thanks, nice and crisp.
It's now in my archives.

Regards,
Howard

 

[joeu2004]

Thanks, nice and crisp.

You're welcome. I just looked at Claus's suggestion, and I see that he and
I are doing essentially the same thing. I simply eschewed the use of a
function (debatable). However, Claus's test is more efficient. So the
better implementation for mine is:

Sub doit()
Dim sh As Range, shlist As Range
Dim nsh As Long
Dim ws As Worksheet

Set shlist = Range("a1", Cells(Rows.Count, "a").End(xlUp))
If Len(shlist(1)) = 0 Then MsgBox "empty list": Exit Sub

Application.ScreenUpdating = False
Set ws = ActiveSheet ' remember original worksheet
On Error Resume Next
nsh = Sheets.Count
For Each sh In shlist
If Sheets(sh.Value) Is Nothing Then
' worksheet does not exist; create it
Err.Clear
Sheets.Add after:=Sheets(nsh)
If Err <> 0 Then MsgBox "too many": GoTo done
nsh = nsh + 1
ActiveSheet.Name = sh
End If
Next

done:
ws.Activate ' return to original worksheet
Application.ScreenUpdating = True
MsgBox "done"
End Sub

 

[Howard]

You're welcome. I just looked at Claus's suggestion, and I see that he and

I are doing essentially the same thing. I simply eschewed the use of a

function (debatable). However, Claus's test is more efficient. So the

better implementation for mine is:



Sub doit()

Dim sh As Range, shlist As Range

Dim nsh As Long

Dim ws As Worksheet



Set shlist = Range("a1", Cells(Rows.Count, "a").End(xlUp))

If Len(shlist(1)) = 0 Then MsgBox "empty list": Exit Sub



Application.ScreenUpdating = False

Set ws = ActiveSheet ' remember original worksheet

On Error Resume Next

nsh = Sheets.Count

For Each sh In shlist

If Sheets(sh.Value) Is Nothing Then

' worksheet does not exist; create it

Err.Clear

Sheets.Add after:=Sheets(nsh)

If Err <> 0 Then MsgBox "too many": GoTo done

nsh = nsh + 1

ActiveSheet.Name = sh

End If

Next



done:

ws.Activate ' return to original worksheet

Application.ScreenUpdating = True

MsgBox "done"

End Sub

Thanks again for the update on your code.

I'm puzzled, what would have to happen to make the msgbox "too many" appear?

Howard

 

[joeu2004]

I'm puzzled, what would have to happen to make the
msgbox "too many" appear?

There are limits on the number worksheets.

As documented, it is limited by available memory. It is also limited by the
max memory that Excel will use, which varies from release to release.

But empirically, I found there is a limit on the worksheet object number
(IIRC). That is incremented monotonically within the same instance of
Excel. So even if we repeatedly delete, then add one worksheet, eventually
the add will fail.

No to worry. IIRC, that limit is around 10,000. I cannot find the details
that I wrote quite some time ago.

 

[Howard]

There are limits on the number worksheets.



As documented, it is limited by available memory. It is also limited by the

max memory that Excel will use, which varies from release to release.



But empirically, I found there is a limit on the worksheet object number

(IIRC). That is incremented monotonically within the same instance of

Excel. So even if we repeatedly delete, then add one worksheet, eventually

the add will fail.



No to worry. IIRC, that limit is around 10,000. I cannot find the details

that I wrote quite some time ago.

Okay, that's some interesting stuff.

Makes me wonder what project would ever require a number of sheets that massive. Say even 300 to 600...?

Maybe I'm a shirt tail relative of that "early days" 3M CEO or was it IBM, who said he could foresee the world wide need of computers to be around five.<g>

Regards,
Howard

 

[joeu2004]

So even if we repeatedly delete, then add one worksheet,
eventually the add will fail. No to worry. IIRC, that
limit is around 10,000.

[....]
Makes me wonder what project would ever require a number
of sheets that massive. Say even 300 to 600...?

You misread. I did not say the limit is 10,000 worksheets. I said that we
"repeatedly delete, then add __one__ worksheet".

It is not uncommon to create temporary worksheets, then delete them. Some
operations are best performed by Excel instead of VBA. And it is not
uncommon do that repeatedly in an algorithm.

FYI, the limit is 10,915 in Excel 2010. And I can hit that limit in a loop
that requires less than 20 sec on my (ancient) computer.

Arguably, it might be better to create one temporary worksheet and use
Activesheet.UsedRange.Clear and perhaps some additional operations. But
that depends on why we are creating temporary worksheets in the first place.
Sometimes it is faster and more reliable to delete and add a new worksheet.

The more likely limitation that your algorithm might hit is due to memory.
As I mentioned before, Excel has an arbitrary limit that might be
significantly less than the computer memory.

 

[Howard]

So even if we repeatedly delete, then add one worksheet,
eventually the add will fail. No to worry. IIRC, that
limit is around 10,000.

[....]

Makes me wonder what project would ever require a number

of sheets that massive. Say even 300 to 600...?

You misread. I did not say the limit is 10,000 worksheets. I said that we

"repeatedly delete, then add __one__ worksheet".



It is not uncommon to create temporary worksheets, then delete them. Some

operations are best performed by Excel instead of VBA. And it is not

uncommon do that repeatedly in an algorithm.



FYI, the limit is 10,915 in Excel 2010. And I can hit that limit in a loop

that requires less than 20 sec on my (ancient) computer.



Arguably, it might be better to create one temporary worksheet and use

Activesheet.UsedRange.Clear and perhaps some additional operations. But

that depends on why we are creating temporary worksheets in the first place.

Sometimes it is faster and more reliable to delete and add a new worksheet.



The more likely limitation that your algorithm might hit is due to memory.

As I mentioned before, Excel has an arbitrary limit that might be

significantly less than the computer memory.

So it is a code repetition issue rather than say... cataloging all the grains of sand on the beaches of California with a serial number, each in a separate cell.

Does that happen very often? I don't recall seeing posts looking for solutions around that issue. However, I mostly only read posts that I have some idea of what they are talking about. And that would be never-never land to this
low-hanging-fruit-only lurker.

Howard