D
Dagonini
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").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
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").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