Managing multilple sheets in one workbook

[HaydenMB]

Hi,

I have some code that opens up our Electronic Advice Notes (These are prettyr much excel spreadsheets our suppliers edit and return) but I am having a few problems selecting different WorkSheets.

The suppliers will group 5 sheets into one workbok and rename them - Although the spreadsheets are protected they can remanee the sheets and group them - so I have trouble changing to other sheets when I don't know their names.

I am using the following lines in the code: -

Dim mySheet As Object

For Each mySheet In ActiveWorkbook.Sheets
Next mySheet

... does anybody have any clues


Also I have problems running this more than once, it will not properly shut Excel down until I close down access and re-open it. I alwatys get an error mesage saying Object Block or with variable not set. does this sound familiar too?


Many Thanks,
Hayden

Here is the code in it's entirety if this helps: -


Private Sub Command4_Click()
On Error GoTo errConfig

Dim strUser As String
Dim strFile As String
Dim Counter As Integer
Dim strLoc As String
Dim appXL As New Excel.Application
Dim wbXL As New Excel.Workbook
Dim wsXL As New Excel.Worksheet
Dim db As DAO.Database
Dim rstHeader As DAO.Recordset
Dim rstParts As DAO.Recordset
Dim strCons As String
Dim intRow As Integer
Dim mySheet As Object
Dim strGSDB As String
Dim datStart As Date
Dim datEnd As Date
Dim strSQL As String
Dim intDaysLess As Integer
Dim intDaysPlus As Integer
Dim PlanDelDate As Date
Dim BookDelDate As Date

[green]'FORCE USER TO SELECT EAN TO OPEN USING OPEN DIALOG BOX[/green]
strFile = Nz(PromptFileName("Select EAN To Import...", OpenExcel, FileLocation), "unkn")
[green]'VALIDATE THAT THE USER HAD SELECTED A VALID FILE NAME[/green]
If strFile = "unkn" Then
MsgBox "You did not choose a valid file!", , conAppName
Exit Sub
End If
[green]'CLEAR PREVIOUS DATA FROM TEMPORARY IMPORT TABLES[/green]
DoCmd.RunSQL "DELETE tbl_Temp_Import_EAN_Header.* FROM tbl_Temp_Import_EAN_Header;"
DoCmd.RunSQL "DELETE tbl_Temp_Import_EAN_Parts.* FROM tbl_Temp_Import_EAN_Parts;"
[green]'CREATE DATABASE AND RECORDSET DETAILS[/green]
Set db = CurrentDb
Set rstHeader = db.OpenRecordset("tbl_Temp_Import_EAN_Header")
Set rstParts = db.OpenRecordset("tbl_Temp_Import_EAN_Parts")
Set wbXL = appXL.Workbooks.Open(strFile)
appXL.Visible = True

For Each mySheet In ActiveWorkbook.Sheets

With appXL

rstHeader.AddNew
strCons = Trim(.Range("C2"))
[green]'WILL NEED TO CHECK FOR MULTIPLE PAGES IN ELECTRONIC ADVICE NOTE
'ADD CONSIGNMENT HEADER DATA TO TEMP TABLE FOR APPROVAL.[/green]
rstHeader!ConsignmentNumber = strCons

strGSDB = Trim(.Range("S4"))
[green]'This section looks for changes from the suppliers address/contacts[/green]
If .Range("C4") = "*" Then
rstHeader!GSDBCode = Trim(.Range("B4"))
End If

If .Range("C5") = "*" Then
rstHeader!SuppName = Trim(.Range("B5"))
End If

If .Range("C7") = "*" Then
rstHeader!City = Trim(.Range("B7"))
End If

If .Range("C8") = "*" Then
rstHeader!PostCode = Trim(.Range("B8"))
End If

If .Range("C9") = "*" Then
rstHeader!Country = Trim(.Range("B9"))
End If

If .Range("C10") = "*" Then
rstHeader!Telephone = Trim(.Range("B10"))
End If

If .Range("C11") = "*" Then
rstHeader!Fax = Trim(.Range("B11"))
End If

If .Range("C12") = "*" Then
rstHeader!Email = Trim(.Range("B12"))
End If
rstHeader!PlanCollectDate = Nz(.Range("G5"))
rstHeader!BookCollectDate = Nz(.Range("F5"), "unkn")
rstHeader!PlanDeliverDate = Nz(.Range("G6"))
PlanDelDate = .Range("G6")
rstHeader!BookDeliverDate = Nz(.Range("F6"), "unkn")
BookDelDate = .Range("F6")
rstHeader!DepsatchNumber = .Range("F11")
rstHeader!DeliverTo = Nz(Trim(.Range("j4")))
rstHeader.Update

Counter = 0
intRow = 17
[green]'This section imports all data and 20 blank lines of information in case[/green]
Do Until Counter = 20
rstParts.AddNew
rstParts!ConsignmentNumber = strCons
rstParts!partnumber = .Range("A" & intRow)
rstParts!supplierpart = .Range("B" & intRow)
rstParts!PlanQuantity = Nz(.Range("C" & intRow), 0)
rstParts!BookQuantity = .Range("D" & intRow)
rstParts!pallets = Nz(.Range("E" & intRow), "0")
rstParts!packages = Nz(.Range("F" & intRow), 0)
rstParts!pltlengh = Nz(.Range("G" & intRow), 0)
rstParts!pltwidth = Nz(.Range("H" & intRow), 0)
rstParts!pltheight = Nz(.Range("I" & intRow), 0)
rstParts!Weight = Nz(.Range("J" & intRow), 0)
If IsNull(.Range("A" & intRow)) Or .Range("A" & intRow) = "" Then
Counter = Counter + 1
End If
intRow = intRow + 1
rstParts.Update
Loop
End With
Next mySheet

[green]'Delete the totally blank lines from the bottonm of the EAN[/green]
DoCmd.OpenQuery "qry_Delete_Null_EAN_Part_Lines"

[green]'Get the day range for the EAN matching[/green]
intDaysLess = DLookup("[DaysBeforeDate]", "[tbl_Import_EAN_Constraints]", "[ID] = " & 1)
intDaysPlus = DLookup("[DaysAfterDate]", "[tbl_Import_EAN_Constraints]", "[ID] = " & 1)
[green]'Calcaulte start and end dates of EAN matches[/green]
datStart = CDate(IIf(BookDelDate = #12:00:00 AM#, PlanDelDate, BookDelDate)) - intDaysLess
datEnd = CDate(IIf(BookDelDate = #12:00:00 AM#, PlanDelDate, BookDelDate)) + intDaysPlus
DoCmd.SetWarnings False


[green]'build SQL to create table with matching delivery date only[/green]
strSQL = "SELECT tbl_IPF_Esecutivo_Header.* INTO tbl_EAN_Matches "
strSQL = strSQL & "FROM tbl_IPF_Esecutivo_Header "
strSQL = strSQL & "WHERE ((([tbl_IPF_Esecutivo_Header].[GSDBCode])='" & strGSDB & "') And (([tbl_IPF_Esecutivo_Header].[DeliveryDate])=#" & Format(CDate(IIf(BookDelDate = #12:00:00 AM#, PlanDelDate, BookDelDate)), "mm/dd/yyyy") & "#));"


Debug.Print CDate(IIf(BookDelDate = #12:00:00 AM#, PlanDelDate, BookDelDate))
DoCmd.RunSQL strSQL

[green]'If there are no exact matches of the delivery date then re-run the process with the additional extra days included[/green]
If DCount("*", "tbl_EAN_Matches") = 0 Then
[green] 'build SQL to create table with start and end dates of EAN matches[/green]
strSQL = "SELECT tbl_IPF_Esecutivo_Header.* INTO tbl_EAN_Matches "
strSQL = strSQL & "FROM tbl_IPF_Esecutivo_Header "
strSQL = strSQL & "WHERE ((([tbl_IPF_Esecutivo_Header].[GSDBCode])='" & strGSDB & "') And (([tbl_IPF_Esecutivo_Header].[DeliveryDate]) Between #" & datStart & "# And #" & datEnd & "#));"

Debug.Print strSQL
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If

If DCount("*", "tbl_EAN_Matches") = 0 Then
MsgBox "There are no planned consignments within a 2 week range of the booked date on the EAN! " & _
"You can do any of the following: - " & vbCrLf & vbCrLf & "1-) Look at the dates on the EAN. If they " & _
"have been entered incorrectly (i.e. Wrong Year) you can change them (Please Note: If the " & _
"BOOKED delivery date is blank the system automaticlaly uses the PLANNED delivery date." & vbCrLf & vbCrLf & _
"2-) Add the consignment manually, this may be an extra collection!", vbInformation, conAppName
GoTo Import_End 'Exit Sub
End If
'Open and set the form properties
DoCmd.OpenForm "frm_Temp_Import_EAN_Header", acNormal
Forms![frm_Temp_Import_EAN_Header].Caption = strFile
Forms![frm_Temp_Import_EAN_Header]![SuppRef] = strGSDB


Import_End:

wbXL.Close SaveChanges:=False
appXL.Quit
Set rstHeader = Nothing
Set rstParts = Nothing
Set appXL = Nothing
Set wbXL = Nothing
Set wsXL = Nothing

DoCmd.Close acForm, "frm_Import_EANs"
Exit Sub
errConfig:
Stop
Select Case Err.Number

Case Is = 3022

MsgBox "There are Multiple EANs that are in the same spreadsheet (Sheet detailed below)" & _
", you cannot import the same EAN twice." & vbCrLf & vbCrLf & "This EAN will have to " & _
"be manually split and entered manually. Please resolve this non conformance " & _
"with the supplier." & vbCrLf & vbCrLf & "File : " & strFile, vbCritical, conAppName

DoCmd.RunSQL "DELETE tbl_Temp_Import_EAN_Header.* FROM tbl_Temp_Import_EAN_Header;"
DoCmd.RunSQL "DELETE tbl_Temp_Import_EAN_Parts.* FROM tbl_Temp_Import_EAN_Parts;"

Case Is = 2428

MsgBox Err.Number & " - " & Err.Description
Stop
Resume Next

Case Else

MsgBox Err.Number & " - " & Err.Description
Resume Next

End Select
wbXL.Close SaveChanges:=False
appXL.Quit
Set rstHeader = Nothing
Set rstParts = Nothing
Set appXL = Nothing
Set wbXL = Nothing
Set wsXL = Nothing
DoCmd.Close acForm, "frm_Import_EANs"


End Sub

 

[VBAjedi]

Didn't take the time to analyze all your code (that's a big chunk!), but if the problem is that you don't know what your suppliers are renaming the sheets it should be a pretty easy fix.

You should be able to refer to your sheets via their code name, which is only changed from the VBA editors properties window (and therefore is unchanged by your suppliers renaming operation). Try opening a new workbook, then renaming Sheet1 to "TestName". Go into the VBA editor, and you will see Sheet1(TestName) in the explorer pane. Sheet1 is the sheets code name. In code this would be treated like any other object (i.e. name is not surrounded by quotes):

Sheet1.Range("A1").Value = "Just checking"

So you could just change your sheets code names (click on the sheet name in the VBA editors' explorer pane, then change the name in the properties pane) to something unique (I wouldn't recommend leaving them as their default code names due to potential confusion with sheets Excel creates in this workbook or other workbooks), and use the code names in your code.

Only thing that won't help you with is sheets the suppliers create, but then again, not much WILL help you in that case.

 

[SkipVought]

HaydenMB,

I did not read you code. You would need to focus on some specific line(s) that are causing you a problem.

However, I can address the changing sheet name issue. Each Sheet Object has 2 properties relating to a name:

1. Name - Its the name that appears as the Sheet Tab

2. CodeName - This name can only be changed in either VB code or VB editor.

Use the Sheet.CodeName property.



Skip,

http://www.TheOfficeExperts.com

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884