I am trying to transfer a macro from one computer to another so that 2
people can use the macro. It works perfectly on the first person's
computer but errors out with an Error 9 (subscript out of range) on
the second. When the macro gets to the line
Workbooks(thisbook).Activate it errors out and i don't know why it
would do it on one computer and not on another. Does anyone have any
ideas?

Thanks!

Here is the macro:

Sub Location_PageBreak_InsertHeader()
'
' Macro
'

'delete header
Rows("3:3").Select
Selection.Delete


'sort by location
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending


' dim variables

Dim d As Double '= number of rows before we start
inserting header rows
Dim f As Double '= number of distinct locations there are
Dim loc As String '= the location in the currently selected
cell
Dim locHold As String '= the location we are comparing to see if
it's time for a pagebreak and header row copy
Dim i As Integer '= looper
Dim locfilename As String
Dim startcell As Integer
Dim endcell As Integer
Dim path As String
Dim locname As String
Dim thisbook As String



' comment/uncomment these lines depending on client vs developer
workstation
' developer runs with first line, client runs with second line
'thisbook = "ColoradoPera_v2.XLT"
thisbook = "ColoradoPera_v2"

path = "C:\_Projects\Colorado Pera\"


'Get number of rows in sheet
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
d = Selection.Count

'Get number of locations in sheet
Range("A3:" & "A" & d).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range( _
"S1"), Unique:=True
Range("S2").Select
Range(Selection, Selection.End(xlDown)).Select
f = Selection.Count
Range("S2").Select
Range(Selection, Selection.End(xlDown)).Delete

'init starting place
locHold = Trim(Cells(3, "A"))
startcell = 3

For i = 3 To d + f
Cells(i, "A").Select
loc = Trim(Cells(i, "A"))
If loc < locHold Then
endcell = i - 1
' comment/uncomment these lines depending on client vs
developer workstation
' developer runs with first line, client runs with second
line
'locfilename = "Location_" & locHold & ".xls"
locfilename = "Location_" & locHold

Workbooks.Add
ActiveWorkbook.SaveAs filename:=path & locfilename, _
FileFormat:=xlNormal, Password:="pera2005",
WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False


ERRORS HERE- Workbooks(thisbook).Activate
Rows("1:2").Select ' select the formatted
header row
Selection.Copy ' and copy it to the
clipboard

Workbooks(locfilename).Activate
Rows("1:2").Select
ActiveSheet.Paste

Workbooks(thisbook).Activate

Rows(startcell & ":" & endcell).Select
Selection.Copy

Workbooks(locfilename).Activate
Range("A3").Select
ActiveSheet.Paste
Columns("K:K").ColumnWidth = 10.43
Columns("L:L").ColumnWidth = 19.14
Columns("M:M").ColumnWidth = 12.14
Columns("N:N").ColumnWidth = 14.57
Columns("O:O").ColumnWidth = 14.86
Columns("P:P").ColumnWidth = 15.57
Columns("Q:Q").ColumnWidth = 13#
Columns("R:R").ColumnWidth = 14.57
Range("A2").Select
locname = Trim(Cells(3, "B"))
Cells(1, "A").Select
With ActiveSheet.PageSetup
.LeftHeader = "&D"
.CenterHeader = "Payroll Deduct File" & Chr(10) &
"Location: " & locname
.RightHeader = ""
.PrintHeadings = False
.PrintGridlines = True
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
.Order = xlDownThenOver
End With
Columns("S:S").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
locHold = loc
startcell = i
End If
Next

Workbooks(thisbook).Activate
Columns("S:S").Select
Selection.Delete Shift:=xlToLeft

Range("A3").Select

Rows("3:3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

Range("A1").Select
ActiveWorkbook.Close SaveChanges = False

Application.Quit


End Sub

Probably because the thisbook doesn't include the .xls extension.

In article .com,
"Dagonini" wrote:

Workbooks(thisbook).Activate it errors out and i don't know why it
would do it on one computer and not on another. Does anyone have any
ideas?

Yes, this is the problem
thisbook = "ColoradoPera_v2"

You have not included the extension. It will work if the user has chosen to
hide known file extensions in the options for Windows (not excel). If not,
then it fails. What always works is if you include the extension

thisbook = "ColoradoPera_v2.xls"

for example should always workd (if that is the extension).

--
Regards,
Tom Ogilvy


"Dagonini" wrote:

I am trying to transfer a macro from one computer to another so that 2
people can use the macro. It works perfectly on the first person's
computer but errors out with an Error 9 (subscript out of range) on
the second. When the macro gets to the line
Workbooks(thisbook).Activate it errors out and i don't know why it
would do it on one computer and not on another. Does anyone have any
ideas?

Thanks!

Here is the macro:

Sub Location_PageBreak_InsertHeader()
'
' Macro
'

'delete header
Rows("3:3").Select
Selection.Delete


'sort by location
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending


' dim variables

Dim d As Double '= number of rows before we start
inserting header rows
Dim f As Double '= number of distinct locations there are
Dim loc As String '= the location in the currently selected
cell
Dim locHold As String '= the location we are comparing to see if
it's time for a pagebreak and header row copy
Dim i As Integer '= looper
Dim locfilename As String
Dim startcell As Integer
Dim endcell As Integer
Dim path As String
Dim locname As String
Dim thisbook As String



' comment/uncomment these lines depending on client vs developer
workstation
' developer runs with first line, client runs with second line
'thisbook = "ColoradoPera_v2.XLT"
thisbook = "ColoradoPera_v2"

path = "C:\_Projects\Colorado Pera\"


'Get number of rows in sheet
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
d = Selection.Count

'Get number of locations in sheet
Range("A3:" & "A" & d).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range( _
"S1"), Unique:=True
Range("S2").Select
Range(Selection, Selection.End(xlDown)).Select
f = Selection.Count
Range("S2").Select
Range(Selection, Selection.End(xlDown)).Delete

'init starting place
locHold = Trim(Cells(3, "A"))
startcell = 3

For i = 3 To d + f
Cells(i, "A").Select
loc = Trim(Cells(i, "A"))
If loc < locHold Then
endcell = i - 1
' comment/uncomment these lines depending on client vs
developer workstation
' developer runs with first line, client runs with second
line
'locfilename = "Location_" & locHold & ".xls"
locfilename = "Location_" & locHold

Workbooks.Add
ActiveWorkbook.SaveAs filename:=path & locfilename, _
FileFormat:=xlNormal, Password:="pera2005",
WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False


ERRORS HERE- Workbooks(thisbook).Activate
Rows("1:2").Select ' select the formatted
header row
Selection.Copy ' and copy it to the
clipboard

Workbooks(locfilename).Activate
Rows("1:2").Select
ActiveSheet.Paste

Workbooks(thisbook).Activate

Rows(startcell & ":" & endcell).Select
Selection.Copy

Workbooks(locfilename).Activate
Range("A3").Select
ActiveSheet.Paste
Columns("K:K").ColumnWidth = 10.43
Columns("L:L").ColumnWidth = 19.14
Columns("M:M").ColumnWidth = 12.14
Columns("N:N").ColumnWidth = 14.57
Columns("O:O").ColumnWidth = 14.86
Columns("P:P").ColumnWidth = 15.57
Columns("Q:Q").ColumnWidth = 13#
Columns("R:R").ColumnWidth = 14.57
Range("A2").Select
locname = Trim(Cells(3, "B"))
Cells(1, "A").Select
With ActiveSheet.PageSetup
.LeftHeader = "&D"
.CenterHeader = "Payroll Deduct File" & Chr(10) &
"Location: " & locname
.RightHeader = ""
.PrintHeadings = False
.PrintGridlines = True
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
.Order = xlDownThenOver
End With
Columns("S:S").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
locHold = loc
startcell = i
End If
Next

Workbooks(thisbook).Activate
Columns("S:S").Select
Selection.Delete Shift:=xlToLeft

Range("A3").Select

Rows("3:3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

Range("A1").Select
ActiveWorkbook.Close SaveChanges = False

Application.Quit


End Sub

did you notice these lines in the code
-----------------------------------------------------------------------------------------
' comment/uncomment these lines depending on client vs developer
workstation
' developer runs with first line, client runs with second line
'thisbook = "ColoradoPera_v2.XLT"
thisbook = "ColoradoPera_v2"
--------------------------------------------------------------------------------------------
I think doing the code below will get it to work

'thisbook = "ColoradoPera_v2.XLT"
Workbooks(thisbook).Activate
On Error Resume Next
thisbook = "ColoradoPera_v2"
Workbooks(thisbook).Activate
' resume normal error checking
On Error GoTo 0
------------------------------------------------------------------------------------------
It seem that you need two sets of code
you could try something like this




"Dagonini" wrote:

I am trying to transfer a macro from one computer to another so that 2
people can use the macro. It works perfectly on the first person's
computer but errors out with an Error 9 (subscript out of range) on
the second. When the macro gets to the line
Workbooks(thisbook).Activate it errors out and i don't know why it
would do it on one computer and not on another. Does anyone have any
ideas?

Thanks!

Here is the macro:

Sub Location_PageBreak_InsertHeader()
'
' Macro
'

'delete header
Rows("3:3").Select
Selection.Delete


'sort by location
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending


' dim variables

Dim d As Double '= number of rows before we start
inserting header rows
Dim f As Double '= number of distinct locations there are
Dim loc As String '= the location in the currently selected
cell
Dim locHold As String '= the location we are comparing to see if
it's time for a pagebreak and header row copy
Dim i As Integer '= looper
Dim locfilename As String
Dim startcell As Integer
Dim endcell As Integer
Dim path As String
Dim locname As String
Dim thisbook As String



' comment/uncomment these lines depending on client vs developer
workstation
' developer runs with first line, client runs with second line
'thisbook = "ColoradoPera_v2.XLT"
thisbook = "ColoradoPera_v2"

path = "C:\_Projects\Colorado Pera\"


'Get number of rows in sheet
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
d = Selection.Count

'Get number of locations in sheet
Range("A3:" & "A" & d).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range( _
"S1"), Unique:=True
Range("S2").Select
Range(Selection, Selection.End(xlDown)).Select
f = Selection.Count
Range("S2").Select
Range(Selection, Selection.End(xlDown)).Delete

'init starting place
locHold = Trim(Cells(3, "A"))
startcell = 3

For i = 3 To d + f
Cells(i, "A").Select
loc = Trim(Cells(i, "A"))
If loc < locHold Then
endcell = i - 1
' comment/uncomment these lines depending on client vs
developer workstation
' developer runs with first line, client runs with second
line
'locfilename = "Location_" & locHold & ".xls"
locfilename = "Location_" & locHold

Workbooks.Add
ActiveWorkbook.SaveAs filename:=path & locfilename, _
FileFormat:=xlNormal, Password:="pera2005",
WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False


ERRORS HERE- Workbooks(thisbook).Activate
Rows("1:2").Select ' select the formatted
header row
Selection.Copy ' and copy it to the
clipboard

Workbooks(locfilename).Activate
Rows("1:2").Select
ActiveSheet.Paste

Workbooks(thisbook).Activate

Rows(startcell & ":" & endcell).Select
Selection.Copy

Workbooks(locfilename).Activate
Range("A3").Select
ActiveSheet.Paste
Columns("K:K").ColumnWidth = 10.43
Columns("L:L").ColumnWidth = 19.14
Columns("M:M").ColumnWidth = 12.14
Columns("N:N").ColumnWidth = 14.57
Columns("O:O").ColumnWidth = 14.86
Columns("P:P").ColumnWidth = 15.57
Columns("Q:Q").ColumnWidth = 13#
Columns("R:R").ColumnWidth = 14.57
Range("A2").Select
locname = Trim(Cells(3, "B"))
Cells(1, "A").Select
With ActiveSheet.PageSetup
.LeftHeader = "&D"
.CenterHeader = "Payroll Deduct File" & Chr(10) &
"Location: " & locname
.RightHeader = ""
.PrintHeadings = False
.PrintGridlines = True
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
.Order = xlDownThenOver
End With
Columns("S:S").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
locHold = loc
startcell = i
End If
Next

Workbooks(thisbook).Activate
Columns("S:S").Select
Selection.Delete Shift:=xlToLeft

Range("A3").Select

Rows("3:3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

Range("A1").Select
ActiveWorkbook.Close SaveChanges = False

Application.Quit


End Sub