Code is in sheet "Summary" module.
This works fine as far as adding a number of sheet and naming them from the list C9:Cn on sheet named "Summary". There are four names and I get four regular sheets with those names.

What I want to do is COPY the sheet next to "Summary" which is named "Main Swb" and name the copies from the list in the "Summary" sheet C9:Cn.

Sheet "Main Swb" has some 'bells and whistles' color formatting, a few formulas and some 'merged cells" (big frown here). I need to keep all the goodies intact when copied and renamed.

So, I wind up with four copies of "Main Swb" with four different names.

I've tried to Set nSht = Sheets("Main Swb").Copy After:=Sheets(Sheets.Count)
but it errors out.

Thanks,
Howard

Option Explicit

Sub CreateSheets()
Dim nSht As Worksheet
Dim r As Integer
r = 9
Do While Sheets("Summary").Cells(r, 3).Value < ""
Set nSht = Sheets.Add
'Names for the new sheet are in C9:Cn of "Summary"
nSht.Name = Sheets("Summary").Cells(r, 3).Value
r = r + 1
Loop
End Sub

Hi Howard,

Am Sun, 7 Apr 2013 07:09:42 -0700 (PDT) schrieb Howard:

Code is in sheet "Summary" module.
This works fine as far as adding a number of sheet and naming them from the list C9:Cn on sheet named "Summary". There are four names and I get four regular sheets with those names.

What I want to do is COPY the sheet next to "Summary" which is named "Main Swb" and name the copies from the list in the "Summary" sheet C9:Cn.

try:

Sub CreateSheets()
Dim LRow As Long
Dim rngC As Range

With Sheets("Summary")
LRow = .Cells(Rows.Count, 3).End(xlUp).Row
For Each rngC In .Range("C9:C" & LRow)
ActiveWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = rngC
Next
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

Am Sun, 7 Apr 2013 16:19:59 +0200 schrieb Claus Busch:

sorry, but I didn't read carefully.
Try:

Sub CreateSheets()
Dim LRow As Long
Dim rngC As Range

With Sheets("Summary")
LRow = .Cells(Rows.Count, 3).End(xlUp).Row
For Each rngC In .Range("C9:C" & LRow)
Sheets("Main Swb").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = rngC
Next
End With
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Sunday, April 7, 2013 7:38:00 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Sun, 7 Apr 2013 16:19:59 +0200 schrieb Claus Busch:



sorry, but I didn't read carefully.

Try:



Sub CreateSheets()

Dim LRow As Long

Dim rngC As Range



With Sheets("Summary")

LRow = .Cells(Rows.Count, 3).End(xlUp).Row

For Each rngC In .Range("C9:C" & LRow)

Sheets("Main Swb").Copy After:=Sheets(Sheets.Count)

ActiveSheet.Name = rngC

Next

End With

End Sub





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Thanks, Claus.

I tried you revised code and it copied several, say about 17, sheets named ("Main Swb12") and various other numbers and ignored the names listed in
For Each rngC In .Range("C9:C" & LRow).

I revised the code to this:

Sub CreateSheetsClaus()
'Dim LRow As Long
Dim rngC As Range

With Sheets("Summary")
'LRow = .Cells(Rows.Count, 3).End(xlUp).Row
For Each rngC In .Range("C9:C24")
Sheets("Main Swb").Copy After:=Sheets(Sheets.Count)
Next
End With
End Sub

And it produced the same thing.
Where Range("C9:C24") on "Summary" sheet has only four names and all other cells are blank. Puzzling.

Here is a link to the workbook I am working with if you get the time to investigate. Not sure what is messing things up.

https://www.dropbox.com/s/3letip961h...20Version.xlsm

Thanks.
Howard



https://www.dropbox.com/s/3letip961h...20Version.xlsm

Hi Howard,

Am Sun, 7 Apr 2013 08:47:17 -0700 (PDT) schrieb Howard:


I tried you revised code and it copied several, say about 17, sheets named ("Main Swb12") and various other numbers and ignored the names listed in
For Each rngC In .Range("C9:C" & LRow).

two things:
1. the code should be placed in a standard module
2. I missed one line of code. The important line:
ActiveSheet.Name = rngC

look here for your workbook "TENDER SHEET":
https://skydrive.live.com/#cid=9378A...121822A3%21191


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

two things:

1. the code should be placed in a standard module

2. I missed one line of code. The important line:

ActiveSheet.Name = rngC



look here for your workbook "TENDER SHEET":

https://skydrive.live.com/#cid=9378A...121822A3%21191





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Good as gold, Claus.

Thanks a bunch.

Regards,
Howard

I tried to have a look at your file but it was no longer there!

While certain that Claus provided an excellent solution, I offer a
version that doesn't loop each range on "Summary" for the names of the
copied sheets.

Sub CopyAndNameSheets()
Dim vNames, n&, lRow&
With Sheets("Summary")
lRow = .Cells(.Rows.Count, 3).End(xlUp).Row
vNames = .Range("C1:C" & lRow)
End With
For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Main Swb")
ActiveSheet.Name = vNames(n, 1)
Next 'n
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Am Sun, 07 Apr 2013 14:24:57 -0400 schrieb GS:

Sub CopyAndNameSheets()
Dim vNames, n&, lRow&
With Sheets("Summary")
lRow = .Cells(.Rows.Count, 3).End(xlUp).Row
vNames = .Range("C1:C" & lRow)
End With
For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Main Swb")
ActiveSheet.Name = vNames(n, 1)
Next 'n
End Sub

you didn't know the structure of the table. So you have to change two
lines of your code:

lRow = 8 + WorksheetFunction.CountA([C9:C24])
vNames = .Range("C9:C" & lRow)


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Sunday, April 7, 2013 11:24:57 AM UTC-7, GS wrote:
I tried to have a look at your file but it was no longer there!



While certain that Claus provided an excellent solution, I offer a

version that doesn't loop each range on "Summary" for the names of the

copied sheets.



Sub CopyAndNameSheets()

Dim vNames, n&, lRow&

With Sheets("Summary")

lRow = .Cells(.Rows.Count, 3).End(xlUp).Row

vNames = .Range("C1:C" & lRow)

End With

For n = LBound(vNames) To UBound(vNames)

Sheets("Main Swb").Copy after:=Sheets("Main Swb")

ActiveSheet.Name = vNames(n, 1)

Next 'n

End Sub



--

Garry



Free usenet access at http://www.eternal-september.org

Classic VB Users Regroup!

comp.lang.basic.visual.misc

microsoft.public.vb.general.discussion

Hi Garry,

Always glad to see/hear your 'Double Eagle' worth of advice. (Where "Double Eagle" replaces "two cents")<g

Here is a new link to a newer version that has the sheet to be copied, "Main Swb", hidden.

I made simple additions to Claus's code and it seems to work quite well.

https://www.dropbox.com/s/vwq5ao0a8x...ox%20V 1.xlsm

I would assume I could add the Unhide / Hide code lines to your version and get the same results.

Howard

Hi Garry,

Am Sun, 07 Apr 2013 14:24:57 -0400 schrieb GS:

Sub CopyAndNameSheets()
Dim vNames, n&, lRow&
With Sheets("Summary")
lRow = .Cells(.Rows.Count, 3).End(xlUp).Row
vNames = .Range("C1:C" & lRow)
End With
For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Main Swb")
ActiveSheet.Name = vNames(n, 1)
Next 'n
End Sub

you didn't know the structure of the table. So you have to change two
lines of your code:

lRow = 8 + WorksheetFunction.CountA([C9:C24])
vNames = .Range("C9:C" & lRow)


Regards
Claus Busch

Claus,
The code is just a general example of how to not read each cell
directly from sheet. Now that I've downloaded Howard's file I see that
it would need to be modified to work with the structure. In this case I
suggest naming the list under col heading "BREAKDOWN" as a dynamic
range, and use this to load vNames.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Always glad to see/hear your 'Double Eagle' worth of advice. (Where
"Double Eagle" replaces "two cents")<g

Here is a new link to a newer version that has the sheet to be
copied, "Main Swb", hidden.

I made simple additions to Claus's code and it seems to work quite
well.

https://www.dropbox.com/s/vwq5ao0a8x...ox%20V 1.xlsm

I would assume I could add the Unhide / Hide code lines to your
version and get the same results.

Howard

Thanks for the link! I got a look at your file and see my code doesn't
fit it exactly. See my reply to Claus for my comments regarding how I'd
approach the task...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Revised as per my suggested approach (and handles the hidden sheet)...

Sub CopySheetAndNameCopies()
Dim vNames, n&
vNames = Sheets("Summary").Range("BreakdownList")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

...where Range("BreakdownList") is a dynamic Defined Name range with
local scope.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Sunday, April 7, 2013 4:52:58 PM UTC-7, GS wrote:
Revised as per my suggested approach (and handles the hidden sheet)...



Sub CopySheetAndNameCopies()

Dim vNames, n&

vNames = Sheets("Summary").Range("BreakdownList")



Application.ScreenUpdating = False

Sheets("Main Swb").Visible = True



For n = LBound(vNames) To UBound(vNames)

Sheets("Main Swb").Copy after:=Sheets("Summary")

ActiveSheet.Name = vNames(n, 1)

Next 'n



Sheets("Main Swb").Visible = False

Application.ScreenUpdating = True

End Sub

..where Range("BreakdownList") is a dynamic Defined Name range with

local scope.

Garry

Thanks,Garry.

I have never worked with hidden sheets before, never had a cause to do so. Not as daunting as I thought it might be.

I'll test fly your code which I know already will work and archive it along with Claus's.

Thanks again.

Howard

Ok! Let me know if you need help with the dynamic named range...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Sunday, April 7, 2013 10:38:51 PM UTC-7, GS wrote:
Ok! Let me know if you need help with the dynamic named range...



--

Garry



Free usenet access at http://www.eternal-september.org

Classic VB Users Regroup!

comp.lang.basic.visual.misc

microsoft.public.vb.general.discussion

I struggled a bit but got an example from excel google where you use =OFFSET(...,etc...,0,)) which is basiclly range("C9:C32") and a counta of the same range. And the name BreakdownList.

It worked with your code. Is that a true dynamic named range? The way the sheet is set up those 24 rows are pretty much the extent of range's range.

Doesn't have room to grow to 75 rows say...

Howard

Hi Claus and Gary,

Turns out once these new sheets are copied, there is a need for formulas on the Summary sheet to refer to certain cells of each new sheet and return values from each new sheet to Summary. I used four offset lines to get it done, while I have some vision of it all in one line...nothing comes to mind..

This works fine, but I would appreciate an assement from you pros.

Sub CreateSheetsClaus_UnHide_Copy_Hide()
Dim rngC As Range
Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True
With Sheets("Summary")
For Each rngC In .Range("C9:C24")
If Len(rngC) 0 Then
Sheets("Main Swb").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = rngC
rngC.Offset(0, 1).Formula = "='" & rngC & "'!G7"
rngC.Offset(0, 2).Formula = "='" & rngC & "'!H7"
rngC.Offset(0, 3).Formula = "='" & rngC & "'!I7"
rngC.Offset(0, 4).Formula = "='" & rngC & "'!J7"
End If
Next
End With
Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

Thanks.
Howard

On Sunday, April 7, 2013 10:38:51 PM UTC-7, GS wrote:
Ok! Let me know if you need help with the dynamic named range...



--

Garry



Free usenet access at http://www.eternal-september.org

Classic VB Users Regroup!

comp.lang.basic.visual.misc

microsoft.public.vb.general.discussion

I struggled a bit but got an example from excel google where you use
=OFFSET(...,etc...,0,)) which is basiclly range("C9:C32") and a
counta of the same range. And the name BreakdownList.

It worked with your code. Is that a true dynamic named range? The
way the sheet is set up those 24 rows are pretty much the extent of
range's range.

Doesn't have room to grow to 75 rows say...

Howard

Well no, that's not the correct way to make a dynamic range because it
includes blanks, which you do not want to process. Here's how I would
define it...

Select C8;
In the Namebox (left of the FormulaBar) type...
"summary!BrkDn_Hdr"
without the quotes;

Open the Name Manager dialog and edit "BreakdownList" RefersTo as
follows...

=OFFSET(BrkDn_Hdr,1,0,COUNTA($C$9:$C$32),1)

...making sure that "Summary" is specified in the Scope field. This will
show the address when typed in the Immediate Window of the VBE...

?range("BreakdownList").Address

...and press Enter to see "$C$9:$C$12", which is the area where the 4
entries under BREAKDOWN reside.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Mon, 8 Apr 2013 06:43:10 -0700 (PDT) schrieb Howard:

rngC.Offset(0, 1).Formula = "='" & rngC & "'!G7"
rngC.Offset(0, 2).Formula = "='" & rngC & "'!H7"
rngC.Offset(0, 3).Formula = "='" & rngC & "'!I7"
rngC.Offset(0, 4).Formula = "='" & rngC & "'!J7"

you can shorten it:
rngC.Offset(0, 1).Resize(1, 4).Formula = _
"='" & rngC & "'!G7"


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Monday, April 8, 2013 7:34:36 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Mon, 8 Apr 2013 06:43:10 -0700 (PDT) schrieb Howard:



rngC.Offset(0, 1).Formula = "='" & rngC & "'!G7"

rngC.Offset(0, 2).Formula = "='" & rngC & "'!H7"

rngC.Offset(0, 3).Formula = "='" & rngC & "'!I7"

rngC.Offset(0, 4).Formula = "='" & rngC & "'!J7"



you can shorten it:

rngC.Offset(0, 1).Resize(1, 4).Formula = _

"='" & rngC & "'!G7"





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Thanks, Claus. As I said I envisioned a one liner but clearly beyond my Excel skills.

Funny though, I can read it and understand what its doing. That will be a good one to keep around and refer to.

Thanks again.

Howard

Well no, that's not the correct way to make a dynamic range because it

includes blanks, which you do not want to process. Here's how I would

define it...



Select C8;

In the Namebox (left of the FormulaBar) type...

"summary!BrkDn_Hdr"

without the quotes;



Open the Name Manager dialog and edit "BreakdownList" RefersTo as

follows...



=OFFSET(BrkDn_Hdr,1,0,COUNTA($C$9:$C$32),1)



..making sure that "Summary" is specified in the Scope field. This will

show the address when typed in the Immediate Window of the VBE...



?range("BreakdownList").Address



..and press Enter to see "$C$9:$C$12", which is the area where the 4

entries under BREAKDOWN reside.



--

Garry


Okay, I'm on it. Might as well do it correctly, eh?

Thanks.
Howard

Hi Howard,

Am Mon, 08 Apr 2013 09:47:35 -0400 schrieb GS:

?range("BreakdownList").Address

..and press Enter to see "$C$9:$C$12", which is the area where the 4
entries under BREAKDOWN reside.

you can also in name manager set the cursor in the formula bar. Then the
range will have running ants.


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

For the non read/write directly to ranges approach, make sure the top
of the code window has the following...

Option Explicit
Option Base 1

...and replace CopySheetAndNameCopies() with whichever of the following
you like...

Sub CopySheetAndNameCopies_v2()
Dim vNames, sFormulas, n&, k&
vNames = Sheets("Summary").Range("BreakdownList")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
sFormulas = "='" & vNames(n, 1) & "'!G7"
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, 4) = sFormulas
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub


Sub CopySheetAndNameCopies_v3()
Dim vNames, vFormulaRefs, vaFormulas(1, 4), n&, k&
vNames = Sheets("Summary").Range("BreakdownList")
vFormulaRefs = Array("G7", "H7", "I7", "J7")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
For k = 1 To 4
vaFormulas(1, k) = "='" & vNames(n, 1) & "'!" & vFormulaRefs(k)
Next 'k
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, UBound(vaFormulas, 2)) = vaFormulas
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

...and take care to catch any line wraps. (All code is single lines)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Mon, 8 Apr 2013 08:32:46 -0700 (PDT) schrieb Howard:

Funny though, I can read it and understand what its doing. That will be a good one to keep around and refer to.

at the moment you have 4 rows in Summary with values. When will you run
the macro? If all 24 rows are filled?
If you run the macro now and later you make new entries and you will run
the macro again, you must test which sheets already exists.
Then you better try:

Sub CopyMainSwb()
Dim arrNames, n As Integer
Dim SheetExists As Boolean

Application.ScreenUpdating = False
With Sheets("Summary")
arrNames = .Range("C9:C32").SpecialCells(xlCellTypeConstants)

For n = LBound(arrNames) To UBound(arrNames)
On Error Resume Next
SheetExists = Not Sheets(arrNames(n, 1)) Is Nothing
If SheetExists = False Then
Sheets("Main Swb").Copy befo=Sheets("NOTES")
ActiveSheet.Name = arrNames(n, 1)
.Range("C9:C32").SpecialCells(xlCellTypeConstants) _
.Cells(n).Offset(, 1).Resize(1, 4) = _
"='" & arrNames(n, 1) & "'!G7"
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Claus,
Very good point!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

at the moment you have 4 rows in Summary with values. When will you run

the macro? If all 24 rows are filled?

If you run the macro now and later you make new entries and you will run

the macro again, you must test which sheets already exists.

Then you better try:



Sub CopyMainSwb()

Dim arrNames, n As Integer

Dim SheetExists As Boolean



Application.ScreenUpdating = False

With Sheets("Summary")

arrNames = .Range("C9:C32").SpecialCells(xlCellTypeConstants)



For n = LBound(arrNames) To UBound(arrNames)

On Error Resume Next

SheetExists = Not Sheets(arrNames(n, 1)) Is Nothing

If SheetExists = False Then

Sheets("Main Swb").Copy befo=Sheets("NOTES")

ActiveSheet.Name = arrNames(n, 1)

.Range("C9:C32").SpecialCells(xlCellTypeConstants) _

.Cells(n).Offset(, 1).Resize(1, 4) = _

"='" & arrNames(n, 1) & "'!G7"

End If

Next

End With

Application.ScreenUpdating = True

End Sub





Regards

Claus Busch


Excellent point!

Up to now I just had a little macro that would delete the newly made sheets so I could go on about doing test with the codes. That issue was bound to come up once the sheet was in general use instead of testing and developing.

Thanks for the look-ahead.

Howard

Revised to handle existing sheets...

Sub CopySheetAndNameCopies_v2()
Dim vNames, sFormulas, n&, k&
vNames = Sheets("Summary").Range("BreakdownList")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
If Sheets(vNames(n, 1)) Is Nothing Then
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1): sFormulas = "='" & vNames(n, 1)
& "'!G7"
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, 4) = sFormulas
End If 'Sheets(vNames(n, 1)) Is Nothing
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

Sub CopySheetAndNameCopies_v3()
Dim vNames, vFormulaRefs, vaFormulas(1, 4)
Dim n&, k&
vNames = Sheets("Summary").Range("BreakdownList")
vFormulaRefs = Array("G7", "H7", "I7", "J7")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
If Sheets(vNames(n, 1)) Is Nothing Then
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
For k = 1 To 4
vaFormulas(1, k) = "='" & vNames(n, 1) & "'!" & vFormulaRefs(k)
Next 'k
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, UBound(vaFormulas, 2)) = vaFormulas
End If 'Sheets(vNames(n, 1)) Is Nothing
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Am Mon, 08 Apr 2013 14:38:11 -0400 schrieb GS:

If Sheets(vNames(n, 1)) Is Nothing Then

you will get an error ^^^^^^

Sub CopyMainSwb()
Dim arrNames, n As Integer

Application.ScreenUpdating = False
With Sheets("Summary")
arrNames = .Range("C9:C32").SpecialCells(xlCellTypeConstants)

For n = LBound(arrNames) To UBound(arrNames)
On Error Resume Next
If Sheets(arrNames(n, 1)) Is Nothing Then
Sheets("Main Swb").Copy befo=Sheets("NOTES")
ActiveSheet.Name = arrNames(n, 1)
.Range("C9:C32").SpecialCells(xlCellTypeConstants) _
.Cells(n).Offset(, 1).Resize(1, 4) = _
"='" & arrNames(n, 1) & "'!G7"
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Thanks, Claus! You're absolutely correct! (I got lazy<g, my bad)...

Sub CopySheetAndNameCopies_v2()
Dim vNames, sFormulas, n&, k&
vNames = Sheets("Summary").Range("BreakdownList")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
If not bSheetExists(vNames(n, 1)) Then
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
sFormulas = "='" & vNames(n, 1) & "'!G7"
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, 4) = sFormulas
End If 'Not bSheetExists
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

Sub CopySheetAndNameCopies_v3()
Dim vNames, vFormulaRefs, vaFormulas(1, 4)
Dim n&, k&
vNames = Sheets("Summary").Range("BreakdownList")
vFormulaRefs = Array("G7", "H7", "I7", "J7")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
If not bSheetExists(vNames(n, 1)) Then
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
For k = 1 To 4
vaFormulas(1, k) = "='" & vNames(n, 1) & "'!" & vFormulaRefs(k)
Next 'k
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, UBound(vaFormulas, 2)) = vaFormulas
End If 'Not bSheetExists
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

Function bSheetExists(WksName) As Boolean
On Error Resume Next
bSheetExists = CBool(Len(ActiveWorkbook.Sheets(WksName).Name))
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Monday, April 8, 2013 12:26:38 PM UTC-7, GS wrote:
Thanks, Claus! You're absolutely correct! (I got lazy<g, my bad)...



Sub CopySheetAndNameCopies_v2()

Dim vNames, sFormulas, n&, k&

vNames = Sheets("Summary").Range("BreakdownList")



Application.ScreenUpdating = False

Sheets("Main Swb").Visible = True



For n = LBound(vNames) To UBound(vNames)

If not bSheetExists(vNames(n, 1)) Then

Sheets("Main Swb").Copy after:=Sheets("Summary")

ActiveSheet.Name = vNames(n, 1)

sFormulas = "='" & vNames(n, 1) & "'!G7"

Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,

1).Resize(1, 4) = sFormulas

End If 'Not bSheetExists

Next 'n



Sheets("Main Swb").Visible = False

Application.ScreenUpdating = True

End Sub



Sub CopySheetAndNameCopies_v3()

Dim vNames, vFormulaRefs, vaFormulas(1, 4)

Dim n&, k&

vNames = Sheets("Summary").Range("BreakdownList")

vFormulaRefs = Array("G7", "H7", "I7", "J7")



Application.ScreenUpdating = False

Sheets("Main Swb").Visible = True



For n = LBound(vNames) To UBound(vNames)

If not bSheetExists(vNames(n, 1)) Then

Sheets("Main Swb").Copy after:=Sheets("Summary")

ActiveSheet.Name = vNames(n, 1)

For k = 1 To 4

vaFormulas(1, k) = "='" & vNames(n, 1) & "'!" & vFormulaRefs(k)

Next 'k

Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,

1).Resize(1, UBound(vaFormulas, 2)) = vaFormulas

End If 'Not bSheetExists

Next 'n



Sheets("Main Swb").Visible = False

Application.ScreenUpdating = True

End Sub



Function bSheetExists(WksName) As Boolean

On Error Resume Next

bSheetExists = CBool(Len(ActiveWorkbook.Sheets(WksName).Name))

End Function



--

Garry

I tried both these subs and as far as I can tell, they do everything needed, testing for already incorporated sheet and doing nothing if no sheet new name is added.

The function is puzzling to me. Can't read what it does.

My next task is to write some code that will delete the sheets that have been entered. I have a little snippet that does that now but it is contained to the generic four names I've been testing with. So I need to give some thought on how I get the myrid of names entered to make sheet for to a "bucket" so I can dump them en-mass if or when needed. Some names will be around for some time and others will come and go at a pace yet to be determined.. The names in column C will be duck soup but deleting a sheet that has the same name as column C, I will have to burn some thought calories. I may be back for help on this but for now I'm off and thinking. As I am typing this it occurs to me maybe I only want to dump a few of the sheets and name not all. Thep plot thickens

Sure do like the codes.

Thanks.

Howard

You're very welcome! Thanks for the feedback!

I have a few different ideas for how to manage deleting sheets, but
I'll wait while you brainstorm awhile.<g

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Monday, April 8, 2013 5:12:48 PM UTC-7, GS wrote:
You're very welcome! Thanks for the feedback!



I have a few different ideas for how to manage deleting sheets, but

I'll wait while you brainstorm awhile.<g



--

Garry

Well, I came up with this pedestrain bit of code, but it only deletes the first sheet of the selected names and all of the names selected then errors out with sub script out of range. Booger!

Option Explicit

Sub DeleteSelectSheet()
Dim c As Range
For Each c In Selection
Application.DisplayAlerts = False
Sheets(c.Value).Delete
Selection.ClearContents
Application.DisplayAlerts = True
Next
End Sub

Howard

Hi Howard,

Am Mon, 8 Apr 2013 23:54:20 -0700 (PDT) schrieb Howard:

Well, I came up with this pedestrain bit of code, but it only deletes the first sheet of the selected names and all of the names selected then errors out with sub script out of range. Booger!

same as add sheets:

Sub DeleteSheets()
Dim arrNames
Dim n As Integer

Application.DisplayAlerts = False
arrNames = Selection
For n = LBound(arrNames) To UBound(arrNames)
Sheets(arrNames(n, 1)).Delete
Selection.Resize(, 5).ClearContents
Next
Application.DisplayAlerts = True
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

same as add sheets:



Sub DeleteSheets()

Dim arrNames

Dim n As Integer



Application.DisplayAlerts = False

arrNames = Selection

For n = LBound(arrNames) To UBound(arrNames)

Sheets(arrNames(n, 1)).Delete

Selection.Resize(, 5).ClearContents

Next

Application.DisplayAlerts = True

End Sub





Regards

Claus Busch

Code is in a module and I get an error on this line.
Tried it in the Summary sheet vb editor first and same error.

For n = LBound(arrNames) To UBound(arrNames)

Howard

On Tuesday, April 9, 2013 12:32:53 AM UTC-7, Howard wrote:




same as add sheets:







Sub DeleteSheets()



Dim arrNames



Dim n As Integer







Application.DisplayAlerts = False



arrNames = Selection



For n = LBound(arrNames) To UBound(arrNames)



Sheets(arrNames(n, 1)).Delete



Selection.Resize(, 5).ClearContents



Next



Application.DisplayAlerts = True



End Sub











Regards



Claus Busch



Code is in a module and I get an error on this line.

Tried it in the Summary sheet vb editor first and same error.



For n = LBound(arrNames) To UBound(arrNames)



Howard

The error is a type missmatch, sorry forgot to say in the other post.

Hi Howard,

Am Mon, 8 Apr 2013 23:54:20 -0700 (PDT) schrieb Howard:

For Each c In Selection
Application.DisplayAlerts = False
Sheets(c.Value).Delete
Selection.ClearContents
Application.DisplayAlerts = True
Next

because you ClearContents into the For-Next-Statement.
So there is no other name left.
In Code below the last line will sort that you don't have empty rows.
Try:

Sub DeleteSheets()
Dim rngC As Range

Application.DisplayAlerts = False
For Each rngC In Selection
Sheets(rngC.Text).Delete
Next
Selection.Resize(, 5).ClearContents
Range("C8:G32").Sort key1:=[C9], order1:=xlAscending, Header:=xlYes
Application.DisplayAlerts = True
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

On Tuesday, April 9, 2013 2:22:42 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Mon, 8 Apr 2013 23:54:20 -0700 (PDT) schrieb Howard:



For Each c In Selection

Application.DisplayAlerts = False

Sheets(c.Value).Delete

Selection.ClearContents

Application.DisplayAlerts = True

Next



because you ClearContents into the For-Next-Statement.

So there is no other name left.

In Code below the last line will sort that you don't have empty rows.

Try:



Sub DeleteSheets()

Dim rngC As Range



Application.DisplayAlerts = False

For Each rngC In Selection

Sheets(rngC.Text).Delete

Next

Selection.Resize(, 5).ClearContents

Range("C8:G32").Sort key1:=[C9], order1:=xlAscending, Header:=xlYes

Application.DisplayAlerts = True

End Sub





Regards

Claus Busch


I tried the code in the sheet vb editor and it deleted the sheets but the names and formulas to the right remain intact.

Produces a error 400

I tried the code in a module and the sheet are deleted and the names and formula remain intact.

errors out on this line yellow hi-light
Selection.Resize(, 5).ClearContents

Howard

Hi Howard,

Am Tue, 9 Apr 2013 02:47:53 -0700 (PDT) schrieb Howard:

I tried the code in the sheet vb editor and it deleted the sheets but the names and formulas to the right remain intact.

that is when the selected cells are not connected.
Place the code in a standard module.
Try:

Sub DeleteSheets()
Dim rngC As Range

Application.DisplayAlerts = False
For Each rngC In Selection
Sheets(rngC.Text).Delete
rngC.Resize(, 5).ClearContents
Next
Range("C8:G32").Sort key1:=[C9], order1:=xlAscending, Header:=xlYes
Application.DisplayAlerts = True
End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

I'm not working on this at the moment but I have given your project
some thought for improving the various processes particular to the way
the project works.

The 1st thing I'd change is the formulas to the right of the names list
so the cells are blank if the name col is blank. This will obviate the
need to program adding the formulas and thus reduce code (and related
maintenance). The sheetname within the formula can be a ref to the
names list col...

example:
=IF(LEN(Sheetname),"'"&Sheetname&"'!G7","")

...where Sheetname is a local scope col-absolute/row-relative defined
name that refs the names list col.

Revising the formulas will simplify removing names from the list
because the formula cols to the right will auto-adjust accordingly. The
list can be resorted so names are contiguous.

Since the table is fixed size, your template can persist the formulas
AND will benefit ongoing maintenance if you include defined names for
all ranges that might be ref'd in formulas/code.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

I forgot to wrap the text for the sheetname ref in the formula for the
cols right of names list on Summary in INDIRECT(). The following
works...

=IF(LEN(Sheetnames),INDIRECT("'"&Sheetnames&"'!G7" ),"")

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

The col name defs are as follows...

colC: "Sheetname" RefersTo: =Summary!$C9
colD: "LabHrs" RefersTo: =Summary!$D9
colE: "LabCost" RefersTo: =Summary!$E9
colF: "MatlCost" RefersTo: =Summary!$F9
colG: "Sell" RefersTo: =Summary!$G9
colI: "SellPlus" RefersTo: =Summary!$CI9

...as defined after selecting any cell in row9.

The total (Q36) is named "Total". Its RefersTo is fully absolute.

The col formulas for the fixed table are as follows:

colD: =IF(LEN(Sheetname),INDIRECT("'"&Sheetname&"'!G7"), "")
colE: =IF(LEN(Sheetname),INDIRECT("'"&Sheetname&"'!H7"), "")
colF: =IF(LEN(Sheetname),INDIRECT("'"&Sheetname&"'!I7"), "")
colG: =IF(LEN(Sheetname),INDIRECT("'"&Sheetname&"'!J7"), "")
colI: =IF(LEN(Sell),Sell+(Total/24),"")

Given the structure of this sheet 'as is', adding new rows to the table
will need to be done manually. I probably would have designed this
sheet so a blank row could be stored (hidden) at the top of the sheet
so I can insert as needed for adding more names. Unfortunately, for
this to work would require relocating the area to the right of the
table so it's above the table in frozen pane area. This approach would
make removing names a simple matter of deleting entire rows, leaving no
required extraneous cleanup processing to do. If you're interested to
review a working copy of this let me know where to send/upload a file.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion