Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Add sheet and name it unless it already exists


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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Add sheet and name it unless it already exists

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
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Add sheet and name it unless it already exists

On Friday, May 10, 2013 6:32:29 AM UTC-7, Claus Busch wrote:
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


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
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Add sheet and name it unless it already exists

Hi Howard,

Am Fri, 10 May 2013 07:41:03 -0700 (PDT) schrieb Howard:

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.


a function or a procedure have to be in a standard module. Only
worksheet events have to be in the code module of the sheet (sheet
module).


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 37
Default Add sheet and name it unless it already exists

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(Befo=ActiveWorkbook.S heets(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(ActiveWork book.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


RBS


"Howard" wrote in message
...

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




  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Add sheet and name it unless it already exists

On Friday, May 10, 2013 7:45:37 AM UTC-7, wrote:
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(Befo=ActiveWorkbook.S heets(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(ActiveWork book.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
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 37
Default Add sheet and name it unless it already exists

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



"Howard" wrote in message
...
On Friday, May 10, 2013 7:45:37 AM UTC-7, wrote:
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(Befo=ActiveWorkbook.S heets(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(ActiveWork book.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


  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 829
Default Add sheet and name it unless it already exists

"Howard" wrote:
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

  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Add sheet and name it unless it already exists

On Saturday, May 11, 2013 12:12:47 AM UTC-7, joeu2004 wrote:
"Howard" wrote:

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


Hi joeu2004,

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

Regards,
Howard


  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 829
Default Add sheet and name it unless it already exists

"Howard" wrote:
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




  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Add sheet and name it unless it already exists

On Saturday, May 11, 2013 8:24:57 AM UTC-7, joeu2004 wrote:
"Howard" wrote:

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


Thanks again for the update on your code.

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

Howard
  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 829
Default Add sheet and name it unless it already exists

"Howard" wrote:
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.

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Rename sheet if current sheet name exists Ron5440 Excel Programming 7 January 7th 10 08:55 PM
If Sheet Exists Q Sean Excel Programming 6 March 5th 08 11:28 AM
If the sheet exists...., then Darin Kramer Excel Programming 5 August 13th 07 04:05 PM
If sheet exists, then... Darin Kramer Excel Programming 9 September 12th 06 01:22 PM
How can I know if a sheet exists ? Ben.C Excel Programming 3 December 29th 03 09:36 AM


All times are GMT +1. The time now is 04:08 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"