View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Dagonini Dagonini is offline
external usenet poster
 
Posts: 18
Default Macro works on one computer but not another

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