Macro works on one computer but not another
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
|