Need contigency plans for data transfer ...

[Ray]

Hi -

I've searched the archives for help on this, but have succeeded in
only confusing myself further -- so I need your help!

I need to check that a workbook contains all 3 worksheets in a
specified array, creating any that are missing -- the code will
(eventually) transfer data from 'basebook' to 'HoursFile'. My
current code is below -- why isn't it working? The line it errors on
is marked.

Thanks, ray


Private Sub SubmitWeekly_Click()
Dim basebook As Workbook, Path As String, HoursFile As Workbook
Dim sh As Worksheet

Set basebook = ThisWorkbook
Store = basebook.Sheets("DB - Hours Reporting").Range("K7").Value
Path = "\\.....\FY08\Hours Report_" & Store & ".xls"

' Check that a STORE # has been entered
If Store = "" Then
Call MsgBox("You MUST select a store before continuing
with this action ....", vbExclamation, "No store selected!")
basebook.Sheets("DB - Hours
Reporting").Range("K7").Select
Exit Sub
Else
End If

If Dir(Path) = "" Then
Workbooks.Add.SaveAs Filename:=Path
Sheets.Add.Name = "wkly Sales"
Sheets.Add.Name = "wkly Hours"
Sheets.Add.Name = "mthly hours"
Else
End If

Set HoursFile = Workbooks.Open(Filename:=Path)

sh = Sheets(Array("wkly Sales", "wkly Hours", "mthly hours"))
'ERRORS OUT HERE!
For Each Sheet In sh
If Not WorksheetExists(sh, HoursFile) Then Sheets.Add.Name
= sh
Next

ActiveSheet.Range("G20").Value = Now

End Sub

 

[Ray]

I forgot to mention that the 'WorksheetExists' function was created by
Chip Pearson ... code below, stored in Module:

Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function

 

[Ray]

I forgot to mention that the 'WorksheetExists' function was created by
Chip Pearson ... code below, stored in Module:

Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function

 

[Tom Ogilvy]

It errors because using the array as you do assumes they all already exist:

Dim s as Variant, sh as Worksheet
s = Array("wkly Sales", "wkly Hours", "mthly hours")
for i = lbound(s) to Ubounds)
set sh = Nothing
On Error Resume Next
sh = worksheets(s(i))
On Error goto 0
If sh is nothing Then Sheets.Add.Name = sh
Next

 

[Ray]

Thanks alot, Tom!

Can you please explain a couple of items from your code:
Why set sh=Nothing?

What does 'On Error goto 0' do?

//ray

 

[Ray]

As follow-up ....

I entered the code and corrected a small typo .... Ubounds) should be
Ubound(s) ..... but I got a 'type mismatch' error at Sheets.Add.Name
=sh

what's going wrong?

//ray

 

[Tom Ogilvy]

My bad. I just used that line from your original and didn't pay much
attention to it.

Dim s as Variant, sh as Worksheet
s = Array("wkly Sales", "wkly Hours", "mthly hours")
for i = lbound(s) to Ubound(s)
set sh = Nothing
On Error Resume Next
sh = worksheets(s(i))
On Error goto 0
If sh is nothing Then Sheets.Add.Name = s(i)
Next

 

[Dave Peterson]

First, there was another(!!!) typo in Tom's code.

He wanted to add a "Set" on that "set sh = worksheets(s(i))" line.

In Tom's new code:

Dim s as Variant, sh as Worksheet
s = Array("wkly Sales", "wkly Hours", "mthly hours")
for i = lbound(s) to Ubound(s)
set sh = Nothing
On Error Resume Next
set sh = worksheets(s(i)) '<-- Set added here
On Error goto 0
If sh is nothing Then Sheets.Add.Name = s(i)
Next i 'I like the variable here <bg>

The "on error resume next" means the next line/group of lines may cause an
error. But he acknowledges that and wants the code to just continue going on.
(when the worksheet doesn't exist, just ignore that error.)

But after the code finishes something that Tom knows may cause an error, Tom
tells the code to go back looking for errors -- "on error goto 0" returns that
error checking control back to the program/VBA.

If you have a worksheet named "wkly sales", then set statement is successful.
sh will "contain" that "wkly sales" worksheet.

If "wkly hours" doesn't exist, then this line "set sh = worksheets(s(i))" will
fail. But sh will still "contain" that "wkly sales" worksheet.

So Tom is clearing out any existing "junk" in that variable so that he can check
to see if that sh contains the next worksheet.

 

[Tom Ogilvy]

Here is an untested recap:

Private Sub SubmitWeekly_Click()
Dim basebook As Workbook, Path As String
Dim HoursFile As Workbook, Store As String
Dim i As Long, Dimsh1 as worksheet
Dim s As Variant, sh As Worksheet

Set basebook = ThisWorkbook
Set sh1 = Activesheet
Store = basebook.Sheets("DB - Hours Reporting" _
).Range("K7").Value
Path = "\\.....\FY08\Hours Report_" _
& Store & ".xls"

' Check that a STORE # has been entered
If Store = "" Then
Call MsgBox("You MUST select a store" & _
" before continuing with this action ....", _
vbExclamation, "No store selected!")
basebook.Sheets("DB - Hours Reporting").Range("K7").Select
Exit Sub
End If

If Dir(Path) = "" Then
Workbooks.Add.SaveAs Filename:=Path
Sheets.Add.Name = "wkly Sales"
Sheets.Add.Name = "wkly Hours"
Sheets.Add.Name = "mthly hours"
Set HoursFile = ActiveWorkbook
Else
Set HoursFile = Workbooks.Open(Filename:=Path)
end if

s = Array("wkly Sales", "wkly Hours", "mthly hours")
For i = LBound(s) To UBound(s)
Set sh = Nothing
On Error Resume Next ' trap the error
'if the sheet doesn't exist

set sh = HoursFile.Worksheets(s(i))

On Error GoTo 0
' return to normal error handling
' check if the sheet didn't exist
If sh Is Nothing Then HoursFile.WorkSheets.Add.Name = s(i)

Next
' it is unclear where you want to make this entry, but I suspect
' it is in the activesheet of thisworkbook:
'ActiveSheet
sh1.Range("G20").Value = Now

End Sub

 

[Ray]

Thanks to BOTH of you for helping fix my code ... and more
importantly, clarifying what the code is actually doing! A quick look
at my profile would show LOTS of questions posted, but I'm answering
more and more on my own and even answering others' questions -- and
that's in large part due to you and other MVPs time and effort!