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 Rhinorhino 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
Joined
Mar 10, 2004
Messages
228
Location
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,

[glasses] When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[tongue]
 
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 Helpful tip
Performing VBA operations in other languages
Replies
1
Views
663
strongm
strongm
Andrzejek
  • Locked
  • Question Question
Open Word as ReadOnly
Replies
6
Views
1K
Chriss Miller
C
remeng
  • Locked
  • Solved
Combine two working macros into one for MS Word
Replies
7
Views
2K
strongm
strongm
cwdrama
  • Locked
  • Question Question
Word w/ Delphi:autotext
Replies
3
Views
324
macropod
macropod
remeng
  • Question Question
Ecel Macros not working with V 2505
Replies
4
Views
198
remeng
remeng

Part and Inventory Search

Sponsor

Back
Top