Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
"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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
"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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
"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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Rename sheet if current sheet name exists | Excel Programming | |||
If Sheet Exists Q | Excel Programming | |||
If the sheet exists...., then | Excel Programming | |||
If sheet exists, then... | Excel Programming | |||
How can I know if a sheet exists ? | Excel Programming |