Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Close w/o Saving - LAN issue

Status
Not open for further replies.
jrobin5881

jrobin5881

Technical User
Mar 10, 2004
228
US
The code below is stored in an Excel spreadsheet that is located on a shared drive that each person in the department can access. I run the file from the shared folder on the LAN and it runs fine. However, when another person runs the file it executes until the save portion of the code(highlighted)whereby I get a runtime error 9 subscript out of range. Any idea why this is occuring?

Code: 
Private Sub Workbook_Open()

Dim strName As String

If Range("N16") = "" Then
    
    strName = InputBox(Prompt:="Enter Date of Report.", _
          Title:="Delivery / Customer Service Daily Mail Condition Report (Summary)", Default:="mm/dd/yy")
         
                
    Range("N16") = strName
    Range("N17") = strName
 
'Run Executive file
 Exec
 
'Run CFS file by Dist
 CFS_File_Transfer
 
'Run Standard delayed top 20
 Standard_File_Transfer
 
'Run Curtailed file top 20
Curtailed

'Run Standard Delayed file by Dist
'delayStd


[b]
Application.Workbooks("excutive").Close SaveChanges:=False
Application.Workbooks("cfs").Close SaveChanges:=False
Application.Workbooks("standard").Close SaveChanges:=False
Application.Workbooks("Curtailed").Close SaveChanges:=False
[/b]



End If

******

'**********************************************************

End Sub
Private Sub Exec()
Dim wbEX As Workbook
 
 'ChDir "T:\OPS\OPSDEL\DELIVERY\CSDRS\excutive.xls"
     Workbooks.OpenText _
        Filename:="T:\OPS\OPSDEL\DELIVERY\CSDRS\excutive.xls", _
        Origin:=437, _
        StartRow:=1, _
        DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, _
        Tab:=True, _
        Semicolon:=False, Comma:=False, _
        Space:=False, _
        Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1)), _
        TrailingMinusNumbers:=True
                
    Set wbEX = ActiveWorkbook
    
    With wbEX.Sheets("excutive")
        '.Columns("B:M").Delete shift:=xlToLeft
        .Columns("R:R").Insert shift:=xlToRight
        .Columns("W:W").Insert shift:=xlToRight
        .Columns("X:X").Insert shift:=xlToRight
        .Columns("AA:AA").Insert shift:=xlToRight
        .Columns("AD:AD").Insert shift:=xlToRight

        '.Columns("R:S").Delete shift:=xlToLeft
        .Range("R2").FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
        .Range("R2").AutoFill Destination:=Range("R2:R9"), Type:=xlFillDefault
        '.Range("R1").FormulaR1C1 = "Pref"
        '.Columns("B:E").EntireColumn.Hidden = True
        
        .Range("W1").FormulaR1C1 = "Del Std"
        .Range("W2").FormulaR1C1 = "=SUM(RC[-4],RC[-2])"
        .Range("W2").AutoFill Destination:=Range("W2:W9"), Type:=xlFillDefault
        
        .Range("X1").FormulaR1C1 = "CS Std"
        .Range("X2").FormulaR1C1 = "=SUM(RC[-4],RC[-2])"
        .Range("X2").AutoFill Destination:=Range("X2:X9"), Type:=xlFillDefault
        '.Columns("G:J").EntireColumn.Hidden = True
        
        .Range("AA1").FormulaR1C1 = "Pkg"
        .Range("AA2").FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
        .Range("AA2").AutoFill Destination:=Range("AA2:AA9"), Type:=xlFillDefault
        '.Columns("L:M").EntireColumn.Hidden = True
        
        .Range("AD1").FormulaR1C1 = "Pri"
        .Range("AD2").FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
        .Range("AD2").AutoFill Destination:=Range("AD2:AD9"), Type:=xlFillDefault
        '.Columns("O:P").EntireColumn.Hidden = True
        '.Columns("A:A").EntireColumn.AutoFit
        
        'copies and pastes delayed
        .Range("R2:R8").Copy
          
        ThisWorkbook.Sheets("CSDRS").Range("B6").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
        
       'copies and pastes delayed 
        .Range("AD2:AD8").Copy
        
        ThisWorkbook.Sheets("CSDRS").Range("F6").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
        
        'copies and pastes delayed DEL  STD
        .Range("W2:W8").Copy
        
        ThisWorkbook.Sheets("CSDRS").Range("J6").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
        
        'copies and pastes delayed CS  STD
        .Range("X2:X8").Copy
        
        ThisWorkbook.Sheets("CSDRS").Range("K6").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
               
        'copies and pastes delayed packages
        .Range("AA2:AA8").Copy
              
        ThisWorkbook.Sheets("CSDRS").Range("B18").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
            
        
    
    End With
    
    
    
 
End Sub
Sub CFS_File_Transfer()
'
'
'
Dim wbEX As Workbook
    
    
    Workbooks.OpenText Filename:="T:\OPS\OPSDEL\DELIVERY\CSDRS\cfs.xls", Origin _
        :=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
        False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _
        ), TrailingMinusNumbers:=True
    
     Set wbEX = ActiveWorkbook
    
    With wbEX.Sheets("cfs")

        
    .Range("B2:B8").Copy
    
    
     ThisWorkbook.Sheets("CSDRS").Range("F18").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
        
        'copies and pastes s
        .Range("I2:I8").Copy
              
        ThisWorkbook.Sheets("CSDRS").Range("J18").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
            
            
End With
    
           
    
  
    
End Sub

Sub Standard_File_Transfer()
'
' Standard_File_Transfer Macro
' Macro recorded 11/10/2004 by James F Robinson
'

'
Dim wbEX As Workbook

    Workbooks.OpenText Filename:="T:\OPS\OPSDEL\DELIVERY\CSDRS\standard.xls", _
        Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1)), TrailingMinusNumbers:=True
    
   Set wbEX = ActiveWorkbook
    
    With wbEX.Sheets("standard")
    
    
        Range( _
        "A1,B:B,D:D,E:E,F:F,G:G,H:H,I:I,J:J,K:K,L:L,M:M,N:N,O:O,P:P,Q:Q,S:S,T:T,U:U,V:V,W:W,X:X,Z:Z" _
        ).Select
  
    Selection.ClearContents
    Columns("S:X").Select
    Selection.Delete shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=-7
    Columns("D:Q").Select
    Range("Q1").Activate
    Selection.Delete shift:=xlToLeft
    Columns("B:B").Select
    Selection.Delete shift:=xlToLeft
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-2]"
    Range("E3").Select
    Selection.AutoFill Destination:=Range("E3:E23"), Type:=xlFillDefault
    Range("E3:E23").Select
    
    Selection.NumberFormat = "0"
    Range("A3:E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A3:E22").Select
    
    Selection.Sort Key1:=Range("D3"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
   
    Columns("B:B").ColumnWidth = 8.57
    Columns("B:B").EntireColumn.AutoFit
    Columns("A:A").ColumnWidth = 8.71
    Columns("A:A").ColumnWidth = 8.86
    
    .Range("A3:B22").Copy
    
    
     ThisWorkbook.Sheets("Sheet1").Range("C4").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
    
    .Range("D3:E22").Copy
    
     ThisWorkbook.Sheets("Sheet1").Range("E4").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
  
  
  End With
    
    
        
End Sub

Sub Curtailed()
'
Dim wbEX As Workbook


    
    Workbooks.OpenText Filename:="T:\OPS\OPSDEL\DELIVERY\CSDRS\curtailed.xls", _
        Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1)), TrailingMinusNumbers:=True
    
    Set wbEX = ActiveWorkbook
    
    With wbEX.Sheets("curtailed") '
  
    
        
    .Range("A2:A21,D2:D21,Y2:Y21").Copy
    
    
ThisWorkbook.Sheets("Sheet1").Range("N4").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
  
    .Columns("B:S").Delete shift:=xlToLeft
    .Columns("F:G").Delete shift:=xlToLeft
    '.Columns("B:C").Delete shift:=xlToLeft
    
    .Range("A1:E1000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    .Range("A1:E1000").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3, 4, 5) _
        , Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
    .Outline.ShowLevels RowLevels:=2
    .Range("A:E").SpecialCells(xlCellTypeVisible).Copy Range("G2")
    .Columns("J:J").Insert shift:=xlToRight
    '.Columns("W:W").Insert shift:=xlToRight
    
   
        .Range("J2").FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
        .Range("J2").AutoFill Destination:=Range("J2:J10"), Type:=xlFillDefault
    
        .Range("M2").FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
        .Range("M2").AutoFill Destination:=Range("M2:M10"), Type:=xlFillDefault
    
   .Range("J3:J10").Copy
    
    
     ThisWorkbook.Sheets("CSDRS").Range("O6").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
   
     .Range("M3:M10").Copy
    
    
     ThisWorkbook.Sheets("CSDRS").Range("P6").PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
    
     
     
     End With


   
  
        
End Sub
 
Sort by date Sort by votes




Hi,

When your code erors, use the watch window faq707-4594 to observe the Workbook Object names
Code: 
workbooks(1).name
use these names (will have the .xls)

Skip,
[sub]
[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue][/sub]
 
Upvote 0 Downvote
this should fix your problem...don't know the cause, different excel versions maybe...

Code: 
Application.Workbooks("excutive[b].xls[/b]").Close SaveChanges:=False
Application.Workbooks("cfs[b].xls[/b]").Close SaveChanges:=False
Application.Workbooks("standard[b].xls[/b]").Close SaveChanges:=False
Application.Workbooks("Curtailed[b].xls[/b]").Close SaveChanges:=False
 
Upvote 0 Downvote
Hi,

The .xls extension was the key! Thanks and I learned alot about the Watch Window as tool as well.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

xwb
  • Locked
  • Helpful tip
Performing VBA operations in other languages
Replies
1
Views
251
strongm
strongm
remeng
  • Locked
  • Solved
Combine two working macros into one for MS Word 1
Replies
7
Views
561
strongm
strongm
cwdrama
  • Locked
  • Question
Word w/ Delphi:autotext
Replies
3
Views
86
macropod
macropod
remeng
  • Locked
  • Helpful tip
Microsoft Office 365 Word Macro Causing a Project is unviewable error
Replies
1
Views
365
dhookom
dhookom
morechocolate
  • Locked
  • Question
run-tune error 3704 operation is not allowed when the object is codes: I don't think so.
Replies
7
Views
635
morechocolate
morechocolate

Part and Inventory Search

Sponsor

Back
Top