PDA

View Full Version : Runtime Error '9' Subscript out of range



jdilts
06-25-2012, 06:46 AM
Hi,

I've been looking at this code and looking at this code. I can't find what is causing this error. (Runtime Error '9' Subscript out of range)

Essentially the script concatenates values to a cell if they meet a certain standard. Once in the cell I get the position of certain values to be colored (store them in an array). After the concatenating is finished I used the saved positions to specifically color certain characters in a cell.

The debugger complains about the line which has "For h = 0 To UBound(colorStart)" under the header
'-------------------------
' Perform coloring
'-------------------------

Function FormatSpreadsheet()

Dim x, j, y, i, k, t, h As Long
Dim LastCol, LastRow As Long
Dim RowPos, ColPos As Long

'-------------------------------------------------------------
' Deleting columns headed with 'AE Comment'
'-------------------------------------------------------------
'Finds the last column in the Range: gives column count
LastCol = Cells.Find("*", SearchOrder:=xlByColumns, _
LookIn:=xlValues, SearchDirection:=xlPrevious).Column

'Deletes the empty columns in the Range
For j = LastCol To 5 Step -3
Columns(j).Delete
Next j

'Find the last used row in column A: gives row count
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

'Selects the starting cell
Range("B2").Select

'-------------------------------------------------------------
' Iterating DOWN the rows
'-------------------------------------------------------------
For x = 1 To LastRow

Dim LastColcurRow, z As Long
'color array is reset every time a new row is reached
Dim colorStart() As Long 'starting character coordinates of colored region
Dim colorEnd() As Long 'ending character coordinates of colored region

'Gets the beginning postion of the row; will have to return here before moving down a row
RowPos = ActiveCell.Row
ColPos = ActiveCell.Column

'Find the last used column in the current row
i = x + 1 'i gives the row number/position, when x = 1 (the 1st row we are working in) i = 2 (since the 1st row we are working in is actually the second)
With ActiveSheet
LastColcurRow = .Cells(i, .Columns.Count).End(xlToLeft).Column
End With
LastColcurRow = (LastColcurRow - 2) / 2 'Gets the number of times to move the selected cell right ACROSS the row, the math is needed because the nested for loop does to slides right

z = 0 'z is the iterator for the color array

'-------------------------------------------------------------
' Iterating ACROSS the rows (nested 'For' loop)
'-------------------------------------------------------------
For y = 1 To LastColcurRow

Dim rPos, cPos As Long
Dim ErPos, EcPos As Long
Dim base1, base2 As Long
Dim diffColor, strt, NNflag As Long

'slides selected cell right one position to 'allele' column
ActiveCell.Offset(0, 1).Select

'-------------------------------------------------------------
' Location: first allele cell
'-------------------------------------------------------------

'-------------------------------------------------------------
' NonNumeric Catch
'-------------------------------------------------------------
'If the first Allele cell is NOT numeric; X
If Not IsNumeric(ActiveCell.Value) And ActiveCell.Column = 3 Then
NNflag = 1 'Sets NonNumeric flag to one
Else
NNflag = 0 'Sets NonNumeric flag to zero
End If

'If the second Allele cell is NOT numeric; Y
If Not IsNumeric(ActiveCell.Value) And ActiveCell.Column = 5 Then
NNflag = 1 'Sets NonNumeric flag to one
Else
NNflag = 0 'Sets NonNumeric flag to zero
End If

'-------------------------------------------------------------
' Numeric Catch
'-------------------------------------------------------------
'stores the concatenation site
If IsNumeric(ActiveCell.Value) And ActiveCell.Column = 3 Then
rPos = ActiveCell.Row
cPos = ActiveCell.Column
End If

'-------------------------------------------------------------
' Location: Not first allele cell
'-------------------------------------------------------------
'store the sites 'to be' concatenated
If IsNumeric(ActiveCell.Value) And ActiveCell.Column <> 3 Then
ErPos = ActiveCell.Row
EcPos = ActiveCell.Column
End If

'-------------------------------------------------------------
' Slide Right to Height Column
'-------------------------------------------------------------
ActiveCell.Offset(0, 1).Select
Height = ActiveCell.Value


'--------------------------------------------------------------------------------------------
' checking data
'--------------------------------------------------------------------------------------------

'-------------------------------------------------------------
' Check NonNumerical Data
'-------------------------------------------------------------
If NNflag = 0 Then

'-------------------------------------------------------------
' Location: first height cell
'-------------------------------------------------------------
'if 1st height under 50,clear the cell
If Height < 50 And ActiveCell.Column = 4 Then
Cells(rPos, cPos).ClearContents
End If

If Height >= 50 And Height <= 99 And ActiveCell.Column = 4 Then
base1 = Len(Cells(rPos, cPos)) 'find the length of the base site
strt = 0
diffColor = base1
End If

'-------------------------------------------------------------
' Location: any height cell, but the first 50<=Height<=99
'-------------------------------------------------------------
'if the height is greater or equal to 50 but less than or equal to 99, concatenate to base site and store information
If Height >= 50 And Height <= 99 And ActiveCell.Column <> 4 Then
'if contents of base site are empty
If Cells(rPos, cPos).Value = "" Then
Cells(rPos, cPos) = Cells(ErPos, EcPos)
Else
base1 = Len(Cells(rPos, cPos)) 'find the length of the base site
Cells(rPos, cPos) = Cells(rPos, cPos) & "," & Cells(ErPos, EcPos) 'concatenate to the base site
base2 = Len(Cells(rPos, cPos)) 'find the length of the base site with the change
diffColor = base2 - base1 'the difference between the two lengths is the length of the characters just concatenated to the base site (important for coloring)

'-------------------------------------------------------------
' storing start and end postions of characters to be colored
'-------------------------------------------------------------
ReDim colorStart(z)
colorStart(z) = (base1 + 1)
z = (z + 1) 'iterate
ReDim colorEnd(z)
colorEnd(z) = diffColor
z = (z + 1) 'iterate

End If

End If

'-------------------------------------------------------------
' Location: any height cell, but the first Height>99
'-------------------------------------------------------------
'if the height is > than 99, then just concatenate to base site
If Height > 99 And ActiveCell.Column <> 4 Then
'if contents of base site are empty
If Cells(rPos, cPos).Value = "" Then
Cells(rPos, cPos) = Cells(ErPos, EcPos)
Else
Cells(rPos, cPos) = Cells(rPos, cPos) & "," & Cells(ErPos, EcPos) 'concatenate to the base site
End If
End If
Else
NNflag = 0
End If

'--------------------------------
'End of Iterating ACROSS the rows
'--------------------------------

'--------------------------------
'Perform coloring
'--------------------------------

'checking if array has any contents
If IsEmpty(colorStart) Then
MsgBox "Array is Empty!"
Else
For h = 0 To UBound(colorStart)
Cells(rPos, cPos).Characters(colorStart(h), colorEnd(h)).Font.Color = &HC0C0C0
Next h
End If

Next y
'Goes back the beginning of the row
Cells(RowPos, ColPos).Select
'Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
'--------------------------------
'End of Iterating DOWN the rows
'--------------------------------
Next x



'-------------------------------------------------------------
' Deleting Leftover Columns
'-------------------------------------------------------------
'Finds the last column in the Range: gives column count
Las = Cells.Find("*", SearchOrder:=xlByColumns, _
LookIn:=xlValues, SearchDirection:=xlPrevious).Column

'Deletes the left over columns
For k = 6 To Las
Columns(6).Delete
Next k

'Deletes the Extra Height Columns
Columns(4).Delete
Range("D2").Select

'Deletes All but 'Y' in second column
For t = 1 To LastRow
If IsNumeric(ActiveCell.Value) Then
ActiveCell.ClearContents
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Next t

'-------------------------------------------------------------
' Modifing Headers
'-------------------------------------------------------------
Range("C1").Select
ActiveCell.Value = "Allele Frequencies"
ActiveCell.Offset(0, 1).Select
ActiveCell.ClearContents

End Function

Kenneth Hobs
06-25-2012, 08:25 AM
I could never get to that part since there were other issues and I don't have your data.

First off, why is this a Function and not a Sub? Always add Option Explicit as the first line of code. Had you done that, you would have seen that some variables were not declared.

Dim Height As Double
Dim Las As Integer

You are bound to run into problems using Las in a Find. Always use Set to set a range variable for a Find. That way, if the range is Nothing, you can check for that as getting the Column value of Nothing will error.

What is the value of ColorStart in Debug mode? Hover the mouse over it to see or use F8 to step through the code and see what is going on. You can use Debug.Print ColorStart after assigning a value to put the value in the Immediate Window.

jdilts
06-25-2012, 01:26 PM
Thanks! I've only been programming vb since last Thursday. I didn't know about option explicit and also F8. Those both helped me work out the bugs! Thanks again!