PDA

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



Danny
03-24-2009, 12:09 PM
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:


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

BrianMH
03-24-2009, 03:10 PM
Where in the code does it fail?

James Niven
03-24-2009, 06:52 PM
[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

Danny
03-24-2009, 07:24 PM
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.


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

Aussiebear
03-25-2009, 05:55 PM
Are you sure the file name is correct?