Adding sheets to summary

[zendog1960]

Good Morning Gurus!

The following is the Summary page. What I would like is to automatically popullate the columns A thru F. If a new sheet is added, by whatever means, The code would look at this list on the summary page and add the necessary sheet name to column A and add the references from that new sheet in the appropriate columns.

How would you code that?

[Bob Phillips]

[vba]

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim iRow As Long
With Worksheets("Summary")
iRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(iRow, "A").Value = Sh.Name
.Cells(iRow, "B").Formula = "='" & Sh.Name & "'!A1" '>=== change cell reference
.Cells(iRow, "C").Formula = "='" & Sh.Name & "'!B1" '>=== change cell reference
.Cells(iRow, "D").Formula = "='" & Sh.Name & "'!C1" '>=== change cell reference
.Cells(iRow, "E").Formula = "='" & Sh.Name & "'!D1" '>=== change cell reference
.Cells(iRow, "F").Formula = "='" & Sh.Name & "'!E1" '>=== change cell reference
.Activate
End With
End Sub

Private Sub Workbook_Open()

End Sub
[/vba]

This is workbook event code.
To input this code, right click on the Excel icon on the worksheet
(or next to the File menu if you maximise your workbooks),
select View Code from the menu, and paste the code

[zendog1960]

[vba]

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim iRow As Long
With Worksheets("Summary")
iRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(iRow, "A").Value = Sh.Name
.Cells(iRow, "B").Formula = "='" & Sh.Name & "'!A1" '>=== change cell reference
.Cells(iRow, "C").Formula = "='" & Sh.Name & "'!B1" '>=== change cell reference
.Cells(iRow, "D").Formula = "='" & Sh.Name & "'!C1" '>=== change cell reference
.Cells(iRow, "E").Formula = "='" & Sh.Name & "'!D1" '>=== change cell reference
.Cells(iRow, "F").Formula = "='" & Sh.Name & "'!E1" '>=== change cell reference
.Activate
End With
End Sub

Private Sub Workbook_Open()

End Sub
[/vba]
This is workbook event code.
To input this code, right click on the Excel icon on the worksheet
(or next to the File menu if you maximise your workbooks),
select View Code from the menu, and paste the code

That code didn't work. I tried to fix it but I am afraid I just do not have the knowledge yet to resolve the issue. Can someone look at it and see if they can resolve it?

[vba]
Private Sub Worksheet_Change(ByVal Target As Range)
Static OldVal
Dim NewVal As String
Dim iRow As Long

If Range("J11").Value <> OldVal Then
NewVal = Range("J11").Value
Range("J11").ClearContents
Dim wSht As Worksheet
Dim shtName As String
shtName = NewVal
For Each wSht In Worksheets
If wSht.Name = shtName Then
MsgBox "Sheet already exists...Make necessary " & _
"corrections and try again."
Exit Sub
End If
Next wSht
Sheets("Template").Copy After:=Sheets("Coin Count")
Sheets("Template").Name = shtName
Sheets(shtName).Move After:=Sheets("Location Summary")
Sheets(shtName).Range("A1") = shtName
Sheets(shtName).Visible = True
Sheets("Template (2)").Name = ("Template")
Sheets("Location Summary").Activate
OldVal = ("")
End If
With Worksheets("Location Summary")
iRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(iRow, "A").Value = shtName
.Cells(iRow, "B").Formula = "='" & shtName & "'!A16" '>=== change cell reference
.Cells(iRow, "C").Formula = "='" & shtName & "'!A4" '>=== change cell reference
.Cells(iRow, "D").Formula = "='" & shtName & "'!A7" '>=== change cell reference
.Cells(iRow, "E").Formula = "='" & shtName & "'!A10" '>=== change cell reference
.Cells(iRow, "F").Formula = "='" & shtName & "'!A13" '>=== change cell reference
End With

End Sub
[/vba]

[Bob Phillips]

Didn't work? In what way, what happened?

[zendog1960]

I get the following message:

Run-Time Error 91
Object Variable or With Block Variable not set.

The error Code line is in red below in the code:

[VBA]
Private Sub Worksheet_Change(ByVal Target As Range)
Static OldVal
Dim NewVal As String
Dim iRow As Long

Application.EnableEvents = False
If Range("J11").Value <> OldVal Then
NewVal = Range("J11").Value
Range("J11").ClearContents
Dim wSht As Worksheet
Dim shtName As String
shtName = NewVal
For Each wSht In Worksheets
If wSht.Name = shtName Then
MsgBox "Sheet already exists...Make necessary " & _
"corrections and try again."
Exit Sub
End If
Next wSht
Sheets("Template").Copy After:=Sheets("Coin Count")
Sheets("Template").Name = shtName
Sheets(shtName).Move After:=Sheets("Location Summary")
Sheets(shtName).Range("A1") = shtName
Sheets(shtName).Visible = True
Sheets("Template (2)").Name = ("Template")
Sheets("Location Summary").Activate
ActiveSheet.Unprotect
With Worksheets("Location Summary")
Dim Sh As Object
iRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(iRow, "A").Value = Sh.Name
.Cells(iRow, "B").Formula = "='" & Sh.Name & "'!A16" '>=== change cell reference
.Cells(iRow, "C").Formula = "='" & Sh.Name & "'!A4" '>=== change cell reference
.Cells(iRow, "D").Formula = "='" & Sh.Name & "'!A7" '>=== change cell reference
.Cells(iRow, "E").Formula = "='" & Sh.Name & "'!A10" '>=== change cell reference
.Cells(iRow, "F").Formula = "='" & Sh.Name & "'!A13" '>=== change cell reference
End With
OldVal = ("")
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
End If
' Call GenSummary
Application.EnableEvents = True
End Sub

[/VBA]

I am not sure but I thought it was declared with the dim statement two line above it. Can anyone help?

[Bob Phillips]

I didn't put it in a Worksheet_Change event, I put it in Workbook_NewSheet.

Why did you change it?

[zendog1960]

I put it there but nothing happened. Was I supposed to call it from the change event? What did that do in the Workbook_NewSheet? I was a bit lost as to what to do with it there so I tried to incorporate it into the one sub. No worries though, if that is where it needs to be I can certainly change it back....

[Bob Phillips]

And note my instructions after the code.

[zendog1960]

[VBA]
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim iRow As Long
With Worksheets("Summary")
iRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(iRow, "A").Value = Sh.Name
.Cells(iRow, "B").Formula = "='" & Sh.Name & "'!A16" '>=== change cell reference
.Cells(iRow, "C").Formula = "='" & Sh.Name & "'!A4" '>=== change cell reference
.Cells(iRow, "D").Formula = "='" & Sh.Name & "'!A7" '>=== change cell reference
.Cells(iRow, "E").Formula = "='" & Sh.Name & "'!A10" '>=== change cell reference
.Cells(iRow, "F").Formula = "='" & Sh.Name & "'!A10" '>=== change cell reference
.Activate
End With
End Sub
[/VBA]

It is the workbook Newsheet area. I run the page, it does make a copy of the template sheet and renames it. It still does not change the Location Summary page at all.

No errors come up however so is there a way to fire up this Workboo_NewSheet code?

[zendog1960]

So it goes in the 'ThisWorkbook' code section? That is where it is. I am using Excel 2007 so there is no icon or file per say ...

[zendog1960]

Since this has gotten off to a bad start, I have attached an example of the workbook. If you type anything in the "Location Summary" sheet in 'J11' that will be the name of the new sheet. Based on the example sheet and the range A3:F3 in the "Location Summary" You can kind of see what I am trying to accomplish.

Any and all help would greatly be appreciated.

Edit Post: Uploaded wrong Workbook but the currently attached is correct.

[Bob Phillips]

What is the purpose of cell J11 that is being tested in the change event and stops anything happeing for me?

[zendog1960]

J11 is where the usere will enter the name of the location. The name they put into J11 well be put into the new sheet at A1 and then added onto the list on the Location Summary page.

[Bob Phillips]

Okay I see it.

The newsheet event won't working because you are copying a sheet, not Insert>New. But you can encapsulate it all in your change event code

[vba]

Private Sub Worksheet_Change(ByVal Target As Range)
Static OldVal
Dim NewVal As String
Dim iRow As Long
Dim wSht As Worksheet

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range("J11")) Is Nothing Then
If Me.Range("J11").Value <> OldVal Then
NewVal = Range("J11").Value
Range("J11").ClearContents
On Error Resume Next
Set wSht = Worksheets(NewVal)
On Error GoTo ws_exit
If Not wSht Is Nothing Then
MsgBox "Sheet already exists...Make necessary " & _
"corrections and try again."
Exit Sub
End If
Worksheets("Template").Copy After:=Sheets("Location Summary")
Worksheets("Template (2)").Name = NewVal
' Worksheets(shtName).Move After:=Sheets("Location Summary")
Set wSht = Worksheets(NewVal)
wSht.Range("A1") = NewVal
iRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row + 1
Me.Cells(iRow, "A").Value = "='" & wSht.Name & "'!A1"
Me.Cells(iRow, "B").Formula = "='" & wSht.Name & "'!A16" '>=== change cell reference
Me.Cells(iRow, "C").Formula = "='" & wSht.Name & "'!A4" '>=== change cell reference
Me.Cells(iRow, "D").Formula = "='" & wSht.Name & "'!A7" '>=== change cell reference
Me.Cells(iRow, "E").Formula = "='" & wSht.Name & "'!A10" '>=== change cell reference
Me.Cells(iRow, "F").Formula = "='" & wSht.Name & "'!A10" '>=== change cell reference
Me.Activate
OldVal = ""
End If
End If
ws_exit:
Application.EnableEvents = True
End Sub
[/vba]

[zendog1960]

Sweet. That is what I was attempting to do. On the flip side of that, if the user wants to delete a sheet from the workbook, he obviously can but on the Location Summary page, the refferences are a errors. What kind of coding would it take to remove the deleted sheet from the list reorganize the list so there will not be any gaps in the list?

Your help has be greatly appreciated and I know I can be a pest at time but I AM learning!

[Bob Phillips]

Does this do what you want? You put the name of the sheet to create in J11 as before, to delete in J12

[vba]

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Static OldVal
Dim NewVal As String
Dim iRow As Long
Dim wSht As Worksheet

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range("J11")) Is Nothing Then
If Me.Range("J11").Value <> OldVal Then
NewVal = Range("J11").Value
Range("J11").ClearContents
On Error Resume Next
Set wSht = Worksheets(NewVal)
On Error GoTo ws_exit
If Not wSht Is Nothing Then
MsgBox "Sheet already exists...Make necessary " & _
"corrections and try again."
Exit Sub
End If
Worksheets("Template").Copy After:=Sheets("Location Summary")
Worksheets("Template (2)").Name = NewVal
' Worksheets(shtName).Move After:=Sheets("Location Summary")
Set wSht = Worksheets(NewVal)
wSht.Range("A1") = NewVal
iRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row + 1
Me.Cells(iRow, "A").Value = "='" & wSht.Name & "'!A1"
Me.Cells(iRow, "B").Formula = "='" & wSht.Name & "'!A16" '>=== change cell reference
Me.Cells(iRow, "C").Formula = "='" & wSht.Name & "'!A4" '>=== change cell reference
Me.Cells(iRow, "D").Formula = "='" & wSht.Name & "'!A7" '>=== change cell reference
Me.Cells(iRow, "E").Formula = "='" & wSht.Name & "'!A10" '>=== change cell reference
Me.Cells(iRow, "F").Formula = "='" & wSht.Name & "'!A10" '>=== change cell reference
Me.Activate
OldVal = ""
End If
ElseIf Not Intersect(Target, Me.Range("J12")) Is Nothing Then
If Me.Range("J12").Value <> OldVal Then
NewVal = Range("J12").Value
Range("J12").ClearContents
On Error Resume Next
Set wSht = Worksheets(NewVal)
On Error GoTo ws_exit
If wSht Is Nothing Then
MsgBox "Sheet doesn't exist, so can't delete"
Exit Sub
End If
On Error Resume Next
iRow = Application.Match(NewVal, Me.Columns(1), 0)
On Error GoTo 0
If iRow > 0 Then
Me.Cells(iRow, "A").Resize(, 6).Delete Shift:=xlUp
End If
Worksheets(NewVal).Delete
End If
End If
ws_exit:
Application.EnableEvents = True
End Sub
[/vba]