0
votes

I'm stock in this code, Subscript out of range error i think it's because the number is too big(LBound(DataArr, 20)?

 For i = LBound(DataArr, 20) To UBound(DataArr, 20) 'change 1->2
        DataArr(i, 86) = "" 'change 3->4 '86
    Next i

For i = LBound(DataArr, 20) To UBound(DataArr, 20) 'change 1->2

Above is my line error if i used LBound(DataArr, 20) Subscript out of range error but if i use LBound(DataArr, 1) or 2 or 3 it's working.. but the column i'm going to count is in Column T = 20 is there any other way?

My Full Code:(edited)

Public Sub Selection()

Dim file2 As Excel.Workbook
Dim Sheet2 As Worksheet, data(), i&
Dim myRangeColor As Variant, myRangeMonthValue
Dim MstrSht As Worksheet
Dim DataArr As Variant
Dim ColorArr As Variant
Dim MonthCol As Collection
Dim CloseToDate As Date
Dim MaxDate As Date
Dim c As Long


Set Sheet2 = Workbooks.Open(TextBox2.Text).Sheets(1)
Set Sheet5 = Workbooks.Open(TextBox5.Text).Sheets(1)


DataArr = Sheet2.Range("A2:CI" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row) 'change 1->2

'Find distinct colors
ColorArr = ReturnDistinct(Sheet2.Range("T2:T" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)) 'change a->b 1->2

'Remove any values in the arrays third column
For i = LBound(DataArr, 1) To UBound(DataArr, 1) 'change 1->2
    DataArr(i, 86) = "" 'change 3->4 '86
Next i

'Loop Each Color
For c = LBound(ColorArr) To UBound(ColorArr)
    Set MonthCol = New Collection
    MaxDate = 0
    For i = LBound(DataArr, 1) To UBound(DataArr, 1) 'change 1->2
        If DataArr(i, 1) = ColorArr(c) Then 'change 1->2
            'Load the colors months into a collection
            On Error Resume Next
            MonthCol.Add Month(DataArr(i, 71)), CStr(Month(DataArr(i, 71))) 'change 2->3
            On Error GoTo 0
            'Find Max Date
            If DataArr(i, 71) Then 'change 2->3
                MaxDate = Application.WorksheetFunction.Max(MaxDate, DataArr(i, 71)) 'change 2->3
            End If
        End If
    Next i

    'If the color were found in three or more seperate months then the row with date closest to CloseToDate gets flagged
    If MonthCol.Count > 2 Then
        For i = LBound(DataArr, 1) To UBound(DataArr, 1) 'change 1->2
            If DataArr(i, 1) = ColorArr(c) And DataArr(i, 71) = MaxDate Then 'change 1->2 2->3
                DataArr(i, 86) = "1" '86
                DataArr(i, 87) = "1" '87
            End If
        Next i
    End If
Next c

'Print results to sheet
Sheet2.Range("A2:CI" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row) = DataArr 'change 1->2

Function ReturnDistinct(InpRng As Range) As Variant
    Dim Cell As Range
    Dim i As Integer
    Dim DistCol As New Collection
    Dim DistArr()

    'Add all values to collection
    For Each Cell In InpRng
        On Error Resume Next
        DistCol.Add Cell.Value, CStr(Cell.Value)
        On Error GoTo 0
    Next Cell

    'Write collection to array
    ReDim DistArr(1 To DistCol.Count)
    For i = 1 To DistCol.Count Step 1
        DistArr(i) = DistCol.Item(i)
    Next i

    ReturnDistinct = DistArr
End Function
1
Use UBound and LBound with 1 or 2 as the second argument for the number of rows or the number of columns (in this order). - John Alexiou

1 Answers

4
votes

For i = LBound(DataArr, 20) To UBound(DataArr, 20) 'change 1->2

You are asking Excel, "what is the lower and upper bound for the 20th rank in DataArr?"

The problem is -- and the reason for the subscript out of range error -- that there is no 20th rank in DataArr. DataArr does in fact only contain 2 ranks. Which means that the LBound and UBound expressions raise errors, since they are being called with invalid arguments.

I am not exactly sure what rank you need to access, but the 20 is what you have to change - and the way your array is set up right now, that number must be either 1 or 2.

EDIT: For your leisure, here is a quick utility written by Chip Pearson that lets you programmatically verify the number of ranks in an array:

Private Function NumberOfArrayDimensions(arr As Variant) As Integer
' By Chip Pearson
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
    Do
        Ndx = Ndx + 1
        Res = UBound(arr, Ndx)
    Loop Until Err.Number <> 0
NumberOfArrayDimensions = Ndx - 1
End Function

EDIT as per your comment:

i want to count the data from column T that way i change it from 1 -> 20

I am not 100% on what you mean by this, but to access data from column T in the array (column number 20), this is the syntax:

someValue = DataArr(i, 20)

where i is (row number - 1) in this case.

For example, DataArr(1, 20) would contain the data from Range("T2") (or Cells(2, 20))

EDIT as per your comments:

this is what i'm trying but insted of columA it's columnT.. My logic

same result, but now i'm going to change the column instead of A it's Column T and instead of B im comparing it with Column BS

Change

For i = LBound(DataArr, 20) To UBound(DataArr, 20) 'change 1->2

to

For i = LBound(DataArr, 1) To UBound(DataArr, 1) 'change 1->2

Because:

The first rank is your rows, the second rank is your columns. There's no 20th rank as previously discussed. Going by your description, it sounds like you need to set every cell inside column number 86 (which I guess is "BS") to nothing. In this case, the above change is correct.