PDA

View Full Version : [SOLVED] Add Sheet Based On Value



stapuff
10-08-2004, 07:53 AM
I have 2 files:
Setup.xls and Shipping Sheet.xls

On Setup.xls I have a button - Button1. On Button1_Click I would like to open up Shipping Sheet.xls and verify if Shipping Sheet.xls has a sheet tab name = to the value of B21 from sheet1 of Setup.xls formatted as MMM/YY if not insert it, name it, and make it the last sheet in the Shipping Sheet workbook.



I can some what follow and understand the SheetExist Function however I am still in need of some help. If I run the code below - it will insert a new sheet in Shipping Sheet.xls if one doesn't exist (in this case Oct 04). If one does exist - a generic sheet will then be created (sheet4, sheet5, etc.). What do I need to do to prevent sheets being added if the sheet already exists and how do I tie it back to the cell B21 in Setup.xls I am not very good at writing code.




Sub Button1_Click()
On Error Resume Next
Workbooks.Open Filename:="F:\Customer Service\Shipping Sheet.xls"
ActiveWorkbook.sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Format(Date, "MMM YY")
End Sub

Private Function SheetExists(sname) As Boolean' Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then
SheetExists = True _ Else SheetExists = False
End Function


Thanks,


Kurt

Richie(UK)
10-08-2004, 09:14 AM
Hi Kurt,

Not tested, but something like this should do it:


Sub Button1_Click()
Dim wbkSS As Workbook, wsNew As Worksheet, strName As String
Set wbkSS = Workbooks.Open(FileName:="F:\Customer Service\Shipping Sheet.xls")
strName = Format(ThisWorkbook.Worksheets("Sheet1").Range("B21").Value, "MMM YY")
If SheetExists(wbkSS, strName) = False Then
Set wsNew = wbkSS.Sheets.Add(After:=wbkSS.Worksheets(Worksheets.Count))
wsNew.Name = strName
End If
End Sub

Private Function SheetExists(wbk As Workbook, sname As String) As Boolean
' Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = wbk.Sheets(sname)
If Err = 0 Then SheetExists = True Else SheetExists = False
End Function

HTH

stapuff
10-08-2004, 10:09 AM
Richie -

I have tested it. Works perfect.

I made a simple change Sheets.Add(After to Before for my own taste.

I hate going back to the well , but I have 1 more request. When a new sheet is added the top row of the last sheet get's copied and pasted to the new sheet. A1:N1 is the range.


Thank You very much for your help. I appreciate every bit of it.

Again - Thank You,

Kurt

Richie(UK)
10-08-2004, 12:42 PM
Hi Kurt,

By all means, go back to the well as often as you wish - people here enjoy helping, otherwise they wouldn't be here ;)

Is this what you had in mind :


Sub Button1_Click()
Dim wbkSS As Workbook, wsNew As Worksheet, strName As String
Set wbkSS = Workbooks.Open(Filename:="F:\Customer Service\Shipping Sheet.xls")
strName = Format(ThisWorkbook.Worksheets("Sheet1").Range("B21").Value, "MMM YY")
If SheetExists(wbkSS, strName) = False Then
With wbkSS
Set wsNew = .Sheets.Add(Before:=.Worksheets(Worksheets.Count))
wsNew.Name = strName
.Worksheets(Worksheets.Count).Range("A1:N1").Copy _
Destination:=wsNew.Range("A1")
End With
End If
End Sub

Private Function SheetExists(wbk As Workbook, sname As String) As Boolean
' Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = wbk.Sheets(sname)
If Err = 0 Then SheetExists = True Else SheetExists = False
End Function

HTH

stapuff
10-08-2004, 01:14 PM
Richie -

Your a God send. To explain how today is going - I ran your code addition and nothing happened. Found out that you need at least 1 sheet to copy the range from the hard way. I deleted the sheet needed just before running the code. lol

Thanks,


Kurt