Help - can't understand why this doesn't work

[mr tom]

Hi,

I've got a control file which produces team workbooks - one sheet per member
of staff. It then adds in a manager template.

All this works.

The final step is to call a procedure, "PrepTheTemplate" which customises
the manager template to make it reflect the contents of the team workbook
(which it resides in). All the code is in the Batch Control workbook.

I think all the code in the "PrepTheTemplate" procedure works, but there's
one problem. No matter what I do, it inststs on executing the code on the
Batch Control workbook rather than the team one.

This has flummoxed everybody who I've been able to get to look at it, but
none of us are much good with VBA.

I'm a little desperate for a solution now as it's holding everything up.

The code is as follows: (the section that should change the context to the
team workbook is denoted by a >>>>>>)

Any help is very gratefully received.

Tom.



Sub PrepTheTemplate(CurrentSupervisor As String, CurrentLocation As String)

'select the correct workbook and sheet
' Workbooks(CurrentLocation + " - " + CurrentSupervisor +
".xls").Sheets(Manager).Select

'dump the sheet names in to cells

sheetlistnumber = 1
Dim wks As Worksheet
For Each wks In Workbooks(CurrentLocation + " - " + CurrentSupervisor +
".xls").Worksheetssheetlistnumber = sheetlistnumber + 1
Next wks

Cells(18, 51).Value = sheetlistnumber - 1


' Fix range of pipeline chart

Worksheets("Manager").ChartObjects("Chart 1").Chart.SetSourceData _
Source:=Worksheets("Manager").Range("dPipelineChart"), PlotBy:=ByRows

'find and replace with range of worksheets

Cells.Replace What:="a1a1a1a1:z9z9z9z9",
Replacement:=Range("BD16").Value, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False


'Clear name of manager sheet from pres area
'Range("A7").Select
'Selection.ClearContents

'nastybit

Dim WorB As Workbook
Dim SHee As Worksheet
Dim Rng As Range
Dim delRng As Range
Dim rCell As Range
Dim CalcMode As Long

Set WorB = ThisWorkbook
Set SHee = WorB.Sheets("Manager") '<<==== CHANGE
Set Rng = SHee.Range("A8:A31") '<<==== CHANGE

On Error Resume Next
Set Rng = Rng.SpecialCells(xlBlanks)
On Error GoTo XIT

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

If Not Rng Is Nothing Then
For Each rCell In Rng.Cells
If delRng Is Nothing Then
Set delRng = rCell.Resize(1, 18)
Else
Set delRng = Union(rCell.Resize(1, 18), delRng)
End If
Next rCell

If Not delRng Is Nothing Then
delRng.Delete shift:=xlUp
End If
End If
XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub

 

[FSt1]

hi,
what are the values of currentsupervior and currentlocation and how did you
set these values?

regards
FSt1

 

[mr tom]

It might read something like "01London - Fred Bloggs.xls", so the filename
contains the office name and the manager's name.

They're set in the macro which calls this one.

They definitely work as the files are successfully generated and I can
successfully switch to the sheets based on that code.

I've set breakpoints etc to see that these are correctly carried through.

Hope that helps.

Tom.

 

[Vergel Adriano]

Tom,

You need to change this line:

Set WorB = ThisWorkbook

to something like

Set WorB = ActiveWorkbook 'get the currently active workbook

or

Set WorB = Workbooks("sample.xls") ' get the workbook named sample.xls


ThisWorkbook refers to the workbook that contains the code and since you
said all your code is in the batch workbook, I think that's where your
problem is..

 

[mr tom]

Thanks. That'll certainly help.

The key stumbling block is a little higher up - it's this code:

Sub PrepTheTemplate(CurrentSupervisor As String, CurrentLocation As String)

'select the correct workbook and sheet

' Workbooks(CurrentLocation + " - " + CurrentSupervisor +
".xls").Sheets(Manager).Select

'dump the sheet names in to cells

sheetlistnumber = 1
Dim wks As Worksheet
For Each wks In Workbooks(CurrentLocation + " - " + CurrentSupervisor +
".xls").Worksheets
sheetlistnumber = sheetlistnumber + 1
Next wks

Cells(18, 51).Value = sheetlistnumber - 1

No matter what I do, it still sumps the sheet names into the Batch Control
book, not the team one.

Cheers,

Tom.

 

[Vergel Adriano]

try removing the leading dots on these lines:

.Cells(sheetlistnumber + 28, 51).Value = wks.Name
.Cells(sheetlistnumber + 6, 1).Value = wks.Name

another suggestion is to assign the workbook to a workbook variable. that
way, you don't always have to refer to it as Workbooks(CurrentLocation + " -
" + CurrentSupervisor + ".xls"). For example:

Dim wb As Workbook

'select the correct workbook and sheet
Set wb = Workbooks(CurrentLocation + " - " + CurrentSupervisor + ".xls")

sheetlistnumber = 1
Dim wks As Worksheet

For Each wks In wb.Worksheets
With wb.Sheets("Manager")
.Cells(sheetlistnumber + 28, 51).Value = wks.Name
.Cells(sheetlistnumber + 6, 1).Value = wks.Name
End With
sheetlistnumber = sheetlistnumber + 1
Next wks

wb.Sheets("Manager").Cells(18, 51).Value = sheetlistnumber - 1

 

[mr tom]

Thanks Vergel - you're a legend!

Tom.

try removing the leading dots on these lines:

.Cells(sheetlistnumber + 28, 51).Value = wks.Name
.Cells(sheetlistnumber + 6, 1).Value = wks.Name

another suggestion is to assign the workbook to a workbook variable. that
way, you don't always have to refer to it as Workbooks(CurrentLocation + " -
" + CurrentSupervisor + ".xls"). For example:

Dim wb As Workbook

'select the correct workbook and sheet
Set wb = Workbooks(CurrentLocation + " - " + CurrentSupervisor + ".xls")

sheetlistnumber = 1
Dim wks As Worksheet

For Each wks In wb.Worksheets
With wb.Sheets("Manager")
.Cells(sheetlistnumber + 28, 51).Value = wks.Name
.Cells(sheetlistnumber + 6, 1).Value = wks.Name
End With
sheetlistnumber = sheetlistnumber + 1
Next wks

wb.Sheets("Manager").Cells(18, 51).Value = sheetlistnumber - 1