Excel Hints

Results 1 to 5 of 5

Thread: Solved: Subscript out of range (Error 9) VBA Code works on one computer but not the other.

  1. #1

    Solved: Subscript out of range (Error 9) VBA Code works on one computer but not the other.

    This code works on my home computer but not my office computer. I am using Excel 2007 at home and 2003 at the office.
    When i try to run it at the office it gives an error 9 subscript out of range. The only thing to change is the directory names
    where the file is saved. The change is as follows, and is only made in 2 place on the code the ChDir statement and the SaveAs statement.

    At home:
    C:\Users\Owner\Desktop\TESTRUN

    At work:
    C\Documents and Settings\danny\Desktop\TESTRUN

    Could this be a version problem with the # of rows?

    Any other ideas on how to make this code more efficient would also be appreciated.

    Here is the code:

    [vba]
    Private Sub ProcessData()

    Const TEST_COLUMN As String = "B" '<=== change to suit
    Dim i As Long
    Dim LastRow As Long
    Dim iPrior As Long, iCurrent As Long, iFuture As Long
    Dim aryCurrent, aryPrior, aryFuture
    Dim ARYHDR
    Dim CheckValue As String
    Dim wb As Workbook
    Dim cell As Range
    Dim chcKvals As Range
    Dim valrnge As Range
    Dim Invals As Range
    Dim Inrnge
    Set wb = ThisWorkbook
    Set chcKvals = wb.Worksheets(2).Range("A2").End(xlDown)
    Set valrnge = wb.Worksheets(2).Range("A2", chcKvals)
    ReDim ARYHDR(1, 1 To 13)
    ARYHDR(0, 1) = "SERVNBR"
    ARYHDR(0, 2) = "INVNBR"
    ARYHDR(0, 3) = "BLK"
    ARYHDR(0, 4) = "LN#"
    ARYHDR(0, 5) = "customer#"
    ARYHDR(0, 6) = "LN LOSS AMT"
    ARYHDR(0, 7) = "APPROVED"
    ARYHDR(0, 8) = "DIFFERENCE"
    ARYHDR(0, 9) = "DIFFERENCE"
    ARYHDR(0, 10) = "Comments"
    ARYHDR(0, 11) = "Comments2"
    ARYHDR(0, 12) = "Comments"
    ARYHDR(0, 13) = "Comments"

    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    End With

    For Each cell In valrnge
    CheckValue = cell.Value
    InvNbr = cell.Offset(0, 1)
    iPrior = 0
    iCurrent = 0
    iFuture = 0
    With wb.Worksheets(1)

    LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
    ReDim aryPrior(1 To LastRow, 1 To 13)
    ReDim aryCurrent(1 To LastRow, 1 To 13)
    ReDim aryFuture(1 To LastRow, 1 To 13)
    For i = 1 To LastRow

    With .Cells(i, TEST_COLUMN)

    If .Value = CheckValue Then

    Select Case .Offset(0, -1).Value
    Case "CM FL"
    iPrior = iPrior + 1
    For x = 1 To 13
    aryPrior(iPrior, x) = .Offset(0, x - 1).Value
    Next
    Case "Supp"
    iCurrent = iCurrent + 1
    For x = 1 To 13
    aryCurrent(iCurrent, x) = .Offset(0, x - 1).Value
    Next

    Case "RA"
    iFuture = iFuture + 1
    For x = 1 To 13
    aryFuture(iFuture, x) = .Offset(0, x - 1).Value
    Next
    End Select
    End If
    End With
    Next i
    End With

    Workbooks.Add (xlWBATWorksheet)
    ChDir "C:\Users\Owner\Desktop\TESTRUN"
    ActiveWorkbook.SaveAs Filename:="C:\Users\Owner\Desktop\TESTRUN\" & InvNbr & "_" & CheckValue _
    & "_LossTieOut" & ".xls", FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False

    With Workbooks(InvNbr & "_" & CheckValue & "_LossTieOut").Worksheets(1)
    Range("A1") = "Invoice"
    Range("A2") = "ServNbr"
    Range("B1") = InvNbr
    Range("B2") = CheckValue
    Range("A1:B2").Borders.Weight = xlThin
    'FRESH LOSS TITLE SECTION
    Range("A4").Value = "Fresh Loss"
    Range("A4").Font.Bold = True
    Range("A4").Borders.Weight = xlMedium
    'FRESH LOSS HEADER SECTION
    Range("A5").Resize(1, 13) = ARYHDR
    Range("A5").Resize(1, 13).Interior.ColorIndex = 4
    Range("A5").Resize(1, 13).Borders.Weight = xlThin
    'FRESH LOSS ARYPRIOR SECTION
    If Not IsEmpty(aryPrior(1, 1)) Then Range("A6").Resize(iPrior, 13) = aryPrior
    If Not IsEmpty(aryPrior(1, 1)) Then Range("A6").Resize(iPrior, 13).Borders.Weight = xlThin
    If Not IsEmpty(aryPrior(1, 1)) Then Range("H6").Resize(iPrior, 1).FormulaR1C1 = "=RC[-2]-RC[-1]"
    'FRESH LOSS TOTAL SECTION
    If IsEmpty(aryPrior(1, 1)) Then iPrior = iPrior + 1
    If IsEmpty(aryPrior(1, 1)) Then Cells(iPrior + 6, "A").Offset(-1, 0).Resize(1, 13).Borders.Weight = xlThin
    Cells(iPrior + 6, "A").Value = "Fresh Loss Total"
    Cells(iPrior + 6, "F").Formula = "=SUM(" & Range("F6").Resize(iPrior, 1).Address(RowAbsolute:=False, _
    ColumnAbsolute:=False) & ")"
    Cells(iPrior + 6, "G").Formula = "=SUM(" & Range("G6").Resize(iPrior, 1).Address(RowAbsolute:=False, _
    ColumnAbsolute:=False) & ")"
    Cells(iPrior + 6, "H").Formula = "=SUM(" & Range("H6").Resize(iPrior, 1).Address(RowAbsolute:=False, _
    ColumnAbsolute:=False) & ")"
    Cells(iPrior + 6, "A").Font.Bold = True
    Cells(iPrior + 6, "A").Font.Underline = True
    Cells(iPrior + 6, "A").Resize(1, 13).Interior.ColorIndex = 8
    Cells(iPrior + 6, "A").Resize(1, 13).Borders.Weight = xlThin
    'SUPPLEMENTAL TITLE SECTION
    Cells(iPrior + 8, "A").Value = "Supplementals"
    Cells(iPrior + 8, "A").Font.Bold = True
    Cells(iPrior + 8, "A").Borders.Weight = xlMedium
    'SUPPLEMENTAL HEADER SECTION
    Cells(iPrior + 9, "A").Resize(1, 13) = ARYHDR
    Cells(iPrior + 9, "A").Resize(1, 13).Interior.ColorIndex = 4
    Cells(iPrior + 9, "A").Resize(1, 13).Borders.Weight = xlThin

    If Not IsEmpty(aryCurrent(1, 1)) Then Cells(iPrior + 10, "A").Resize(iCurrent, 13) = aryCurrent
    If Not IsEmpty(aryCurrent(1, 1)) Then Cells(iPrior + 10, "A").Resize(iCurrent, 13).Borders.Weight _
    = xlThin
    If Not IsEmpty(aryCurrent(1, 1)) Then Cells(iPrior + 10, "H").Resize(iCurrent, 1).FormulaR1C1 = _
    "=RC[-2]-RC[-1]"

    If IsEmpty(aryCurrent(1, 1)) Then iCurrent = iCurrent + 1
    If IsEmpty(aryCurrent(1, 1)) Then .Cells(iPrior + iCurrent + 10, "A").Offset(-1, 0). _
    Resize(1, 13).Borders.Weight = xlThin
    Cells(iPrior + iCurrent + 10, "A").Value = "Supplemental Total"
    Cells(iPrior + iCurrent + 10, "F").Formula = "=SUM(" & Cells(iPrior + 10, "F").Resize(iCurrent, _
    1).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")"
    Cells(iPrior + iCurrent + 10, "G").Formula = "=SUM(" & Cells(iPrior + 10, "G").Resize(iCurrent, 1).Address _
    (RowAbsolute:=False, ColumnAbsolute:=False) & ")"
    Cells(iPrior + iCurrent + 10, "H").Formula = "=SUM(" & Cells(iPrior + 10, "H").Resize(iCurrent, 1).Address _
    (RowAbsolute:=False, ColumnAbsolute:=False) & ")"
    Cells(iPrior + iCurrent + 10, "A").Font.Bold = True
    Cells(iPrior + iCurrent + 10, "A").Font.Underline = True
    Cells(iPrior + iCurrent + 10, "A").Resize(1, 13).Interior.ColorIndex = 8
    Cells(iPrior + iCurrent + 10, "A").Resize(1, 13).Borders.Weight = xlThin

    Cells(iPrior + iCurrent + 12, "A").Value = "Remit Adjustment"
    Cells(iPrior + iCurrent + 12, "A").Font.Bold = True
    Cells(iPrior + iCurrent + 12, "A").Borders.Weight = xlMedium

    Cells(iPrior + iCurrent + 13, "A").Resize(1, 13) = ARYHDR
    Cells(iPrior + iCurrent + 13, "A").Resize(1, 13).Interior.ColorIndex = 4
    Cells(iPrior + iCurrent + 13, "A").Resize(1, 13).Borders.Weight = xlThin

    If Not IsEmpty(aryFuture(1, 1)) Then Cells(iPrior + iCurrent + 14, "A") _
    .Resize(iFuture, 13) = aryFuture
    If Not IsEmpty(aryFuture(1, 1)) Then Cells(iPrior + iCurrent + 14, "A"). _
    Resize(iFuture, 13).Borders.Weight _
    = xlThin
    If Not IsEmpty(aryFuture(1, 1)) Then Cells(iPrior + iCurrent + 14, "H"). _
    Resize(iFuture, 1).FormulaR1C1 _
    = "=RC[-2]-RC[-1]"

    If IsEmpty(aryFuture(1, 1)) Then iFuture = iFuture + 1
    If IsEmpty(aryFuture(1, 1)) Then Cells(iPrior + iCurrent + iFuture + 14, "A") _
    .Offset(-1, 0).Resize(1, 13). _
    Borders.Weight = xlThin
    Cells(iPrior + iCurrent + iFuture + 14, "A").Value = "Remit Adjustment Total"
    Cells(iPrior + iCurrent + iFuture + 14, "F").Formula = "=SUM(" & Cells(iPrior + iCurrent _
    + 13, "F").Resize(iFuture, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")"
    Cells(iPrior + iCurrent + iFuture + 14, "G").Formula = "=SUM(" & Cells(iPrior + iCurrent _
    + 13, "G").Resize(iFuture, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")"
    Cells(iPrior + iCurrent + iFuture + 14, "H").Formula = "=SUM(" & Cells(iPrior + iCurrent _
    + 13, "H").Resize(iFuture, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")"
    Cells(iPrior + iCurrent + iFuture + 14, "A").EntireRow.Font.Bold = True
    Cells(iPrior + iCurrent + iFuture + 14, "A").EntireRow.Font.Underline = True
    Cells(iPrior + iCurrent + iFuture + 14, "A").EntireRow.Resize(1, 13).Interior.ColorIndex = 8
    Cells(iPrior + iCurrent + iFuture + 14, "A").EntireRow.Resize(1, 13).Borders.Weight = xlThin

    Cells(iPrior + iCurrent + iFuture + 16, "F").Formula = "=" & Cells(iPrior + iCurrent + iFuture _
    + 14, "F").Address (RowAbsolute:=False, ColumnAbsolute:=False) & "+" & Cells(iPrior _
    + iCurrent + 10, "F").Address(RowAbsolute:=False, ColumnAbsolute:=False) & "+" & Cells(iPrior + 6, _
    "F").Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Cells(iPrior + iCurrent + iFuture + 16, "G").Formula = "=" & Cells(iPrior + iCurrent + iFuture _
    + 14, "G").Address (RowAbsolute:=False, ColumnAbsolute:=False) & "+" & Cells(iPrior _
    + iCurrent + 10, "G").Address(RowAbsolute:=False, ColumnAbsolute:=False) & "+" & Cells(iPrior + 6, _
    "G").Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Cells(iPrior + iCurrent + iFuture + 16, "H").Formula = "=" & Cells(iPrior + iCurrent + iFuture _
    + 14, "H").Address (RowAbsolute:=False, ColumnAbsolute:=False) & "+" & Cells(iPrior + _
    iCurrent + 10, "H").Address(RowAbsolute:=False, ColumnAbsolute:=False) & "+" & Cells _
    (iPrior + 6, "H").Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Cells(iPrior + iCurrent + iFuture + 16, "F").Borders.Weight = xlMedium
    Cells(iPrior + iCurrent + iFuture + 16, "G").Borders.Weight = xlMedium
    Cells(iPrior + iCurrent + iFuture + 16, "H").Borders.Weight = xlMedium

    Columns("A:H").AutoFit
    Sheets("Sheet1").Name = "LossTieOut"
    End With
    'Workbooks(InvNbr & "_" & CheckValue & "_LossTieOut").Worksheets(1).Columns("A:H").AutoFit
    'Workbooks(InvNbr & "_" & CheckValue & "_LossTieOut").Sheets("Sheet1").Name = "LossTieOut"
    Workbooks(InvNbr & "_" & CheckValue & "_LossTieOut").Save
    Workbooks(InvNbr & "_" & CheckValue & "_LossTieOut").Close
    Next cell
    With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    End With
    End Sub
    [/vba]
    Last edited by Danny; 03-24-2009 at 09:12 PM.

  2. #2
    Where in the code does it fail?

  3. #3
    VBAX Regular
    Joined
    Nov 2008
    Location
    Cedar Creek, Texas
    Posts
    72
    Location
    [quote=Danny]This code works on my home computer but not my office computer. I am using Excel 2007 at home and 2003 at the office.
    When i try to run it at the office it gives an error 9 subscript out of range. The only thing to change is the directory names
    where the file is saved. The change is as follows, and is only made in 2 place on the code the ChDir statement and the SaveAs statement.

    At home:
    C:\Users\Owner\Desktop\TESTRUN

    At work:
    C\Documents and s\Settings\danny\Destktop\TESTRUN

    Hi Danny,

    This my be a long shot, but look at the directory format above for Home and then at work, Desktop has a T in it for work. Is this a typo on your behalf typing the message or is this on your work computer this way?

    Just an observation!!

    Thanks

    James Niven
    Cedar Creek, TX

  4. #4
    James,
    That is just a typo on the message (but most of the time, you would be right). Sorry about that.

    Brian,
    The code fails after the new workbook is opened and saved. This is the line where the code stops:
    Thanks.

    [vba]
    With Workbooks(InvNbr & "_" & CheckValue & "_LossTieOut").Worksheets(1)

    [/vba]
    I not only use all the brains that I have, but all that I can borrow.

  5. #5
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    3,304
    Location
    Are you sure the file name is correct?
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •