Array - Subscript out of range in VBA - vba

I am trying to store the values inside an array. I am facing a problem it says subscript out of range.
This is the code,
Sub Trial()
Dim HeaderArray() As Variant
Dim HeaderValue As String
Dim j As Long
Dim i as Long
set wk = Activeworkbook
lastrow_header_Config = Wk.Sheets("Config").Cells(Rows.Count, "W").End(xlUp).Row
j = 1
For i = 2 To lastrow_header_Config
HeaderValue = Wk.Sheets("Config").Range("W" & i).Value
If HeaderValue <> "" Then
HeaderArray(j - 1) = HeaderValue // Subscript out of range error
j = j + 1
End If
Next
End Sub
What is the mistake I am making. Kindly advise.


You need to declare the size of the array before trying to put data in it. Use COUNTA to find the number of cells with data in your range:
Sub Trial()
Dim HeaderArray() As Variant
Dim HeaderValue As String
Dim lastrow_Header_Config As Long
Dim j As Long
Dim i As Long
Set Wk = ActiveWorkbook
lastrow_Header_Config = Wk.Sheets("Config").Cells(Rows.Count, "W").End(xlUp).Row
ReDim HeaderArray(Application.WorksheetFunction.CountA(Wk.Sheets("Config").Range("W2:W" & lastrow_Header_Config))-1) As Variant
j = 0
For i = 2 To lastrow_Header_Config
HeaderValue = Wk.Sheets("Config").Range("W" & i).Value
If HeaderValue <> "" Then
HeaderArray(j) = HeaderValue
j = j + 1
End If
Next
End Sub


try this and see how it works for you
pay close attention to the ReDim HeaderArray(j) line and the ReDim Preserve HeaderArray(j) lines
Sub Trial()
Dim HeaderArray() As Variant
Dim HeaderValue As String
Dim j As Long
Dim i As Long
Set Wk = ActiveWorkbook
lastrow_header_Config = Wk.Sheets("Config").Cells(Rows.Count, "W").End(xlUp).Row
j = 1
ReDim HeaderArray(j) '<============= initialize your array length
For i = 2 To lastrow_header_Config
HeaderValue = Wk.Sheets("Config").Range("W" & i).Value
If HeaderValue <> "" Then
ReDim Preserve HeaderArray(j) '<================= adjust your array length to accomodate the additional info
HeaderArray(j - 1) = HeaderValue '// Subscript out of range error
j = j + 1
End If
Next
End Sub
Also you might want to read up on using the option keyword. Arrays by default have the first data point at index 0 so for example array(1) creates an array that has 1 data point, however to reference that data point you would use array(0). if you wanted the first data point in the array to be referenced using array(1), then you would use the Option Base 1 keyword at the very top of your module.


On the first pass, j = 1. Therefore you try to set HeaderArray(0) a value, while HeaderArray is probably 1 based.
You can eventually use Option Base 0, or explicitely Redim HeaderArray(0 to 10) (or whatever value you need)

Related

Is it possible to declare a constant based on a preexisting variable's value in VBA?

I need to create a multidimensional array, but I do not know the height of the array.
I get this value and store it in a variable. Unfortunately I cannot use a variable when declaring the array, I need to use constants. So I thought that I could just declare a constant from the variable, but then I get the same error "Constant Expression Required" just on an earlier line.
lr = Tables.Cells(Rows.Count, 1).End(xlUp).Row
Const constlr As Integer = lr
Dim TableNamesArr(2 To constlr, 1 To 4) As String
Dim i As Integer, j As Integer
For i = 2 To lr
For j = 1 To 4
TableNamesArr(i, j) = Tables.Cells(i, j).Value
Next j
Next i
Currently line 3 is the issue -
Const constlr As Integer = lr
but if I remove that line and change all constlr to lr, then it is line 5 -
Dim TableNamesArr(2 To lr, 1 To 4) As String.
The lr is the problem, it needs to be an integer or constant, but not a variable holding an integer
The code works fine if I change:
Const constlr As Integer = lr
to
Const constlr As Integer = 102

You can use a variable in Redim, not in Dim. You actually don't need the constant for this.
lr = Tables.Cells(Rows.Count, 1).End(xlUp).Row
Const constlr As Integer = lr
Dim TableNamesArr() As String
Redim TableNamesArr(2 To constlr, 1 To 4)
Dim i As Integer, j As Integer
For i = 2 To lr
For j = 1 To 4
TableNamesArr(i, j) = Tables.Cells(i, j).Value
Next j
Next i

You can read values from Range without looping, in a simple way:
Dim DirArray As Variant
DirArray = Range("a1:a5").Value
Instead of Range("a1:a5") you may reference your range by selection or other methods Selection.Value or Activesheet.UsedRange.Value.
If your range is in a table you may try this code stolen from here:
Sub MultiColumnTable_To_Array()
Dim myTable As ListObject
Dim myArray As Variant
Dim x As Long
'Set path for Table variable
Set myTable = ActiveSheet.ListObjects("Table1")
'Create Array List from Table
myArray = myTable.DataBodyRange
'Loop through each item in Third Column of Table (displayed in Immediate Window [ctrl + g])
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x, 3)
Next x
End Sub

Split string into matrix vba

I have 3 informations on a row and I can have multiple row selected. So what I'm looking for is a way to split a first time each row into an array.
That's what I'm doing here.
line = Split(msg, ",")
Then I want to for every line to split info to obtain a matrix with first identifer the line and the second is the info
ReDim pro(Ubound(line),3)
For i = 0 To Ubound(line)
pro(i) = Split(ligne(i), "/")
Next
But It throw me a mismatch error so I don't know how to do it
for example :
I have this
msg1/1250/Description,msg2/1500/Description2,msg3,45656,Desctiption3
And finally have this :
pro(0,0) = msg1
pro(0,1) = 1250
pro (1,1) = 1500
etc ...
Thank you

Not optimal in any way, but it should give you a start:
Dim RowCount As Integer
Dim i As Integer
Dim j As Integer
Dim x As Variant
Dim y As Variant
Line = "msg1/1250/Description,msg2/1500/Description2,msg3/45656/Desctiption3"
RowCount = UBound(Split(Line, ",")) + 1
ReDim pro(RowCount, 3)
For Each x In Split(Line, ",")
j = 0
For Each y In Split(x, "/")
pro(i, j) = y
j = j + 1
Next y
i = i + 1
Next x

What you have initially as pro is called a "jagged array". You can use a "double-transpose" to transform it into a 2D array. But beware that it needs that all the "line arrays" be of the same size:
Function toMatrix(msg as string)
Dim line: line = Split(msg, ",")
ReDim pro(UBound(line))
Dim i As Long
For i = 0 To UBound(line)
pro(i) = Split(line(i), "/")
Next
' transform array of arrays into a 2D array.
toMatrix = Application.Transpose(Application.Transpose(pro))
End Function
Sub Test
Dim msg As String
msg = "msg1/1250/Description,msg2/1500/Description2,msg3/45656/Desctiption3"
Dim ar
ar = toMatrix(msg) ' ar is now a 2D array
End Sub

This is how I did it:
Option Explicit
Public Sub TestMe()
Dim strInput As String
Dim arrVals As Variant
Dim arrVar As Variant
Dim arrVar2 As Variant
Dim arrResult As Variant
Dim lngCount As Long: lngCount = 0
strInput = "msg1/1250/Description,msg2/1500/Description2,msg3/45656/Desctiption3"
arrVals = Split(strInput, ",")
ReDim arrResult(UBound(arrVals), 1)
For Each arrVar In arrVals
arrVar2 = Split(arrVar, "/")
arrResult(lngCount, 0) = arrVar2(0)
arrResult(lngCount, 1) = arrVar2(1)
lngCount = lngCount + 1
Next arrVar
End Sub
That's the result:
As far as I did not see that you need a DescriptionN I have skipped it.

VBA to extract names from a list at random isn't working

I want to randomly extract 280 names from a list (dynamic range) of thousands of authors, then concatenate them into 1 string with each name separated by OR.
So far I'm stuck at the first part. When I run the following code, nothing happens. Can anyone explain why? Thanks.
Sub Authors()
Dim InputRange As Range
Dim AuthorCount As Long
Dim AuthorRange As Excel.Range
Set InputRange = Range("A:A")
AuthorCount = Application.WorksheetFunction.CountA(InputRange) - 1
Set AuthorRange = ThisWorkbook.Worksheets("Sheet").Range("A2:A" & AuthorCount)
Const nItemsToPick As Long = 280
Dim Authorlist As Variant
Dim i As Long
ReDim Authorlist(1 To nItemsToPick)
For i = 1 To nItemsToPick
Authorlist(i) = AuthorRange.Cells(Int(AuthorCount * Rnd + 1), 1)
Next i
End Sub

Using the below code
Sub PickSample(intSampleSize As Integer, intPicks As Integer)
Dim arr() As String
Dim intCounter As Integer
ReDim arr(intPicks)
For intCounter = 0 To UBound(arr)
arr(intCounter) = CStr(Int((intSampleSize - (i - 1)) * Rnd + 1) + (i - 1))
Next intCounter
Debug.Print Join(arr(), ",")
End Sub
I ran this on the following, PickSample(10,5) and got the following, showing the duplicate possibilities, this will become less as the difference between picks and samples increases.
9,9,6,10,10,2
5,3,6,7,2,3
10,4,5,8,0,6
9,8,4,10,9,0
0,8,8,7,0,4
7,5,6,3,3,8
If your selection is 280, but the data set is only 300, dupes still arise
PickSample 300,280
228,**92**,248,216,269,66,**107**,166,**107**,61,174,189,41,18,190,252,192,127,56,149,292,231,114,145,164,202,11,194,270,102,35,128,232,**107**,124,225,131,216,152,52,83,26,294,85,186,**92**,256,96,239,52,90,21,148,136,179,9,95,40,98,228,188,290,249,166,182,57,271,95,180,179,230,215,206,228,77,165,153,170,84,125,105,292,156,175,139,9,113,41,196,46,59,112,28,185,211,132,126,101,210,64,13,266,13,138,222,227,247,63,141,261,249,123,139,105,75,242,163,162,188,26,214,77,17,82,289,98,194,109,111,98,64,63,127,185,72,206,177,181,23,13,46,74,120,175,86,251,270,158,116,0,75,49,194,295,93,72,264,39,171,182,183,208,255,29,118,247,80,204,119,251,130,251,65,220,270,65,295,290,262,157,195,137,47,193,184,257,110,15,152,16,112,135,89,291,3,195,184,160,8,215,94,295,87,109,96,106,70,178,211,80,173,173,298,280,75,243,231,122,189,148,150,40,291,53,177,205,32,195,222,234,129,24,150,172,17,124,35,43,94,298,181,82,125,141,19,137,131,284,82,52,152,103,154,119,78,20,192,109,164,265,127,178,114,17,32,43,43,228,79,41,12,208,254,155,240,296,157,20,188,99,83
4,50,49,153,122,31,83,193,255,149,56,269,112,97,232,65,134,71,264,183,112,117,259,176,280,155,99,261,77,78,53,104,0,223,253,83,211,121,244,223,131,23,123,102,213,93,240,45,178,287,73,282,34,296,190,180,271,173,73,258,22,132,228,73,113,119,158,81,174,63,23,269,33,196,271,69,285,254,132,148,231,251,115,58,98,124,45,186,29,61,208,151,55,298,141,1,128,86,226,268,247,53,32,3,45,113,56,294,262,175,219,43,77,8,249,235,238,100,135,167,241,169,61,62,109,172,103,158,128,172,15,164,62,289,280,298,252,123,242,297,77,52,209,5,102,208,33,33,87,120,168,93,88,243,93,113,120,253,123,218,198,122,286,194,155,67,175,225,137,272,85,200,267,84,110,4,88,296,229,174,182,80,152,238,258,28,163,125,22,135,210,150,122,284,296,178,160,185,26,55,85,5,45,126,165,168,235,12,122,17,93,181,155,179,99,273,231,173,129,220,49,17,73,228,286,103,205,238,10,239,145,62,181,273,284,196,4,199,290,2,287,22,88,175,243,12,16,169,94,124,153,220,135,97,22,123,172,229,174,196,243,125,239,217,208,219,57,232,21,74,286,246,66,55,71,278,77,77,215,200,232
209,294,73,160,32,300,203,4,173,30,31,240,85,13,89,114,90,285,294,120,83,48,49,194,123,124,214,98,190,62,55,175,24,137,272,78,236,114,87,276,190,188,128,29,168,209,275,251,6,163,275,129,204,151,154,139,106,121,81,16,73,294,18,117,109,147,46,142,77,189,163,47,282,197,152,117,32,235,138,226,179,250,5,63,22,31,99,38,0,161,197,163,249,24,57,204,136,107,45,212,279,159,26,228,120,139,148,62,99,28,177,51,279,29,133,82,262,225,82,202,77,27,9,97,237,89,70,144,76,102,13,145,62,260,177,227,279,99,163,24,190,123,289,34,277,186,104,44,144,66,299,39,8,103,164,277,162,122,255,248,202,217,300,102,149,124,209,53,127,163,245,162,128,153,68,186,147,204,266,111,91,88,45,159,67,175,109,263,143,57,205,224,184,235,48,243,60,287,19,18,238,114,139,35,34,52,14,215,160,168,65,140,224,226,120,271,224,26,191,214,4,129,120,82,296,241,209,125,221,83,107,130,284,36,194,104,31,55,23,130,288,163,148,292,65,114,119,84,151,41,155,290,167,273,197,132,208,19,227,210,149,46,67,98,236,15,155,227,241,97,292,242,203,272,263,125,37,287,239,209,120
Using a dictionary to handle the dupes, using this code
Sub PickSample(intSampleSize As Integer, intPicks As Integer)
Dim dicPicked As New Scripting.Dictionary
Dim arr() As String
Dim intCounter As Integer
Dim intPicked As Integer
ReDim arr(intPicks)
For intCounter = 0 To UBound(arr)
RetryPick:
intPicked = CStr(Int((intSampleSize - (i - 1)) * Rnd + 1) + (i - 1))
If dicPicked.Exists(CStr(intPicked)) Then
GoTo RetryPick
Else
dicPicked.Add CStr(intPicked), 1
arr(intCounter) = intPicked
End If
Next intCounter
Debug.Print Join(arr(), ",")
dicPicked.RemoveAll
Set dicPicked = Nothing
End Sub
Gives results, hopefully dupe free
PickSample 300,280
203,125,69,114,26,208,39,219,36,174,220,113,24,74,104,282,128,112,223,205,200,147,44,143,152,162,157,300,70,54,108,177,13,276,153,91,7,168,89,145,127,12,16,257,187,229,61,213,117,214,254,171,59,242,23,51,224,52,185,165,193,189,21,296,63,173,160,280,190,232,235,141,256,56,87,98,32,5,267,195,77,120,197,82,288,68,57,136,132,182,122,15,47,48,261,96,110,258,49,105,155,86,186,97,225,80,264,140,11,46,199,230,275,19,34,83,222,66,116,294,298,259,292,271,272,84,115,101,124,43,183,71,289,291,25,188,55,158,150,216,243,92,58,0,290,148,255,149,250,167,27,233,228,265,9,299,65,283,62,88,207,240,109,179,161,178,268,278,175,139,237,234,169,297,269,281,184,262,270,164,202,279,253,295,196,212,8,274,159,75,172,163,130,38,154,73,99,247,249,263,273,67,40,20,221,138,14,33,218,286,227,251,94,166,209,156,211,37,137,90,131,111,107,2,215,85,146,100,293,204,231,285,79,53,126,60,239,260,248,78,4,217,29,64,121,226,201,210,45,206,134,17,1,192,246,3,35,191,236,93,28,41,244,287,129,277,142,118,6,81,18,135,181,241,180,103,50,252,31,95,30
44,278,132,10,232,56,146,193,284,276,236,155,79,117,102,61,119,200,229,131,138,133,235,173,204,34,7,98,3,202,167,143,130,30,126,206,13,262,221,166,174,298,111,116,39,288,263,76,47,170,89,268,154,253,52,91,217,148,12,22,83,33,77,264,85,214,55,127,279,251,101,86,230,35,172,59,198,62,286,296,220,29,191,242,271,5,54,84,297,158,38,270,231,107,95,110,57,129,9,273,53,269,68,4,234,228,211,207,70,153,151,194,179,128,169,63,142,109,145,58,186,24,245,60,87,0,17,246,225,222,218,184,258,26,161,226,247,31,144,178,223,122,88,124,137,210,293,94,99,213,190,281,80,72,104,40,6,123,290,259,254,45,78,66,227,289,261,141,65,135,8,274,69,257,203,168,196,42,248,67,73,125,37,11,287,181,92,291,238,108,212,1,118,28,216,244,164,249,240,150,46,74,277,36,189,188,255,224,195,260,15,175,267,280,49,180,27,165,50,113,243,201,237,149,205,156,199,292,136,48,71,75,285,41,81,239,209,185,266,160,176,152,171,163,100,2,32,183,16,97,19,294,187,20,282,272,157,182,121,140,106,112,265,295,51,21,256,64,241,114,162,90,252,115,25,82,103,23,299,120,197
57,241,105,1,247,289,284,72,89,68,101,225,295,242,290,5,291,217,267,87,62,80,24,106,103,38,285,197,286,300,151,222,219,254,201,113,195,245,243,15,179,98,145,192,74,118,142,109,70,58,11,4,154,277,129,115,250,202,293,163,181,168,288,268,281,112,79,49,60,175,236,23,266,186,59,167,190,187,41,228,174,157,48,231,165,253,227,171,66,176,135,238,120,258,19,110,194,164,131,296,91,206,159,255,8,189,124,148,114,13,75,121,95,272,119,214,50,117,279,213,205,133,96,196,137,173,246,218,233,77,27,264,141,184,193,263,102,83,244,210,78,127,36,63,188,42,0,152,198,271,169,298,207,111,3,158,182,282,30,226,199,17,273,297,191,166,46,144,252,55,25,26,200,86,162,237,211,299,212,287,161,12,40,45,69,216,54,125,71,47,132,93,22,20,76,126,51,262,107,229,234,257,2,39,278,235,84,37,280,208,153,251,67,136,104,28,221,149,248,276,170,140,14,269,180,16,108,34,94,43,92,52,204,65,134,85,183,7,146,143,97,270,64,259,139,160,260,223,32,81,177,33,178,185,90,292,9,232,209,265,10,88,283,147,123,99,261,240,6,138,274,122,61,203,249,155,256,44,294,116,35

this function picks nItemsToPick random elements up from arr array and returns them into an array:
Function PickNRandomElementsFromArray(arr As Variant, nItemsToPick As Long) As Variant
Dim arrSize As Long
Dim i As Long, iPick As Long
Dim temp As String
arrSize = UBound(arr) '<--| count the values as the array size
If nItemsToPick > arrSize Then nItemsToPick = arrSize '<--| the items to be picked cannot exceed array size
For i = 1 To nItemsToPick
iPick = Int((arrSize - (i - 1)) * Rnd + 1) + (i - 1) '<--| pick a random number between 'i' and 'arrSize'
' swap array elements in slots 'i' and 'iPick'
temp = arr(iPick)
arr(iPick) = arr(i)
arr(i) = temp
Next i
ReDim Preserve arr(1 To nItemsToPick) '<--| resize the array to first picked items
PickNRandomElementsFromArray = arr '<--| return the array
End Function
which you can exploit as follows:
Option Explicit
Sub Authors()
Dim Authors As Variant, AuthorsList As Variant
With ThisWorkbook.Worksheets("Sheet") '<--| reference your relevant worksheet
Authors = Application.Transpose(.Range("A2", .Cells(.rows.count, 1).End(xlUp)).Value) '<--| fill 'Authors' array with its column "A" values from row 2 down to its last not empty one
AuthorsList = PickNRandomElementsFromArray(Authors, 280) '<--| fill 'AuthorsList' array with a selection of 280 random elements of 'Authors'
.Range("B1").Value = Join(AuthorsList, " OR ") '<--| fill cell "B1" with a string build by concatenating 'AuthorsList' values delimited with " OR "
End With
End Sub
that can be quite contracted (and made as much less readable) to:
Sub Authors()
With ThisWorkbook.Worksheets("Sheet") '<--| reference your relevant worksheet
.Range("B1").Value = Join(PickNRandomElementsFromArray(Application.Transpose(.Range("A2", .Cells(.rows.count, 1).End(xlUp)).Value), 280), " OR ")
End With
End Sub

From your comments, you seem to want to concatenate the array of strings, then put it back into excel. This, put just before the End Sub, will put it into cell B1 for example:
ThisWorkbook.Worksheets("Sheet1").Range("B1").Value = Join(Authorlist, "OR")

Storing a range in a variable

i need to put in a variable a range of values, i.e. the variable
tsPeriod(1) = (3, 4, 5)
tsPeriod(3) = (1, 2, 3).
I don't know what kind of variable to declare and how to do it. I've tried to do something like this:
Dim tsPeriod() as long
ReDim tsPeriod(nSub) as long
for i = 1 to nSub
tsPeriod(i) = (tsStart(i), tsEnd(i))
next
But it doesnt work that way and im kinda lost how to put that "range" into that variable. (if the first value is 3 and the second is 6 i want the variable to retrieve (3, 4, 5, 6))
Below is part of the code:
Dim wb As Workbook
Set wb = ThisWorkbook
Dim subjects As Worksheet
Set subjects = wb.Sheets("Subject")
Dim nSub As Integer, nRooms As Integer
nSub= subjects.Cells(Rows.Count, 1).End(xlUp).value
Dim tsStart() As Long
ReDim tsStart(nSub) As Long
For i = 1 To nSub
tsStart(i) = subjects.Cells(i + 1, 3).value
Next
Dim tsBusy() As Long
ReDim tsBusy(numDis) As Long
For i = 1 To nSub
tsBusy(i) = subjects.Cells(i + 1, 4).value
Next
Dim tsEnd() As Long
ReDim tsEnd(nSub) As Long
For i = 1 To nSub
tsEnd(i) = tsStart(i) + tsBusy(i) - 1
Next
'Here's where im having trouble
Dim tsPeriod() As Long
ReDim tsPeriod(nSub) As Long
For i = 1 To nSub
tsPeriod(i) = (tsStart(i), TsEnd(i))
Next

There is no built-in "range" method in VBA: you need to dimension an array of the required size and fill it using a loop. You can create a function to do this:
Function RRange(startNum, endNum)
Dim rv() as long, i
Redim rv(1 to (endnum-startnum)+1)
for i = startNum to endNum
rv((i-startNum)+1) = i
next i
RRange = rv
End Function
Then:
For i = 1 To numDis
tsPeriod(i) = RRange(tsStart(i), TsEnd(i))
Next

You can use the combination of Application.Transpose, Evaluate and the worksheets-ROW function to get there.
For the
tsPeriod(i) = (tsStart(i), TsEnd(i))
simply use
tsPeriod(i) = Application.Transpose(Evaluate("=ROW(" & tsStart(i) & ":" & tsEnd(i) & ")"))
To get an array from the first to the last value.
To just get a comma-separated string, put this in a Join like this
tsPeriod(i) = Join(Application.Transpose(Evaluate("=ROW(" & tsStart(i) & ":" & tsEnd(i) & ")")), ",")
Join also is good for testing if everything is fine, because you can use Debug.Print.

Subscript out of Range - Run time error 9

This the code I am trying to run:
Option Explicit
Sub Test()
'-------------Declarations-------------------
Dim FinalRow, Sum As Long
Dim i, j, l, d, k, count As Integer
Dim custID(), amtPur() As Long
Dim ws As Worksheet
Set ws = Sheets("Data")
FinalRow = ws.Range("B90000").End(xlUp).Row
j = 0
'-------------Get All the Data-------------------
With ws
For i = 4 To FinalRow
custID(j) = ws.Range("B" & i).Value 'Error Here
amtPur(j) = ws.Range("C" & i).Value 'Error Here
j = j + 1
Next i
End With
'-------------Match it and present the output----
l = 4
Dim wk As Worksheet
Set wk = Sheets("Results")
With wk
For j = 0 To FinalRow
Sum = amtPur(j)
'For the first iteration
If j = 0 Then
For k = j + 1 To FinalRow
If custID(j) = custID(k) Then
Sum = amtPur(k) + Sum
Else: End If
Next k
wk.Range("A" & 3).Value = custID(j).Value
wk.Range("B" & 3).Value = Sum
Else: End If
'For the rest iterations
count = 0
d = j
Do While (d >= 0)
If custID(d) = custID(j) Then
count = count + 1
Else: End If
d = d - 1
Loop
If count <= 1 Then 'Check if instance was already found
For k = j + 1 To FinalRow
If custID(j) = custID(k) Then
Sum = amtPur(k) + Sum
Else: End If
Next k
wk.Range("A" & l).Value = custID(j).Text
wk.Range("B" & l).Value = Sum
l = l + 1
End If
Next j
End With
End Sub
but unfortunately am getting:
Subscript out of Range - Run time error 9
when I try to run it.

While you have declared your custID() and amtPur() arrays, they need to be initialised using ReDim statements before you can use them. In your case you will want to ReDim Preserve to retain values already stored in the arrays during prior loops:
Sub Test()
'-------------Declarations-------------------
Dim FinalRow, Sum As Long
Dim i As Integer
j As Integer
l As Integer
d As Integer
k As Integer
count As Integer
Dim custID() As Long, amtPur() As Long
Dim ws As Worksheet
Set ws = Sheets("Data")
FinalRow = ws.Range("B90000").End(xlUp).Row
j = 0
'-------------Get All the Data-------------------
With ws
For i = 4 To 100
ReDim Preserve custID(0 To j)
ReDim Preserve amtPur(0 To j)
custID(j) = ws.Range("B" & i).Value 'Error Here
amtPur(j) = ws.Range("C" & i).Value 'Error Here
j = j + 1
Next i
End With
End Sub

Hmm, seems a little harsh that this question has been downvoted. You're clearly new to VBA and it does seem that you've given this a fair go. I admire people who learn through trial and error - it's certainly more than many first posters do - so I'd like to give you a pretty full answer with a bit of the theory behind it:
Dim - as mentioned, declare each type. Avoid names that are similar to existing functions, like sum.
If you declare your 'read' variable as a variant, you can read the data from the worksheet with just one line and the array will be dimensioned for you. You can also acquire custID and amtPur in the same array. I've given you an example of this in the code below in a variable called custData. Be aware that these arrays have a base of 1 rather than 0.
Your With blocks are redundant. These are meant to save you repeating the object each time you access its properties. In your code you repeat the object. I'm not a huge fan of With blocks but I've put a sample in your code so you can see how it works.
Your If ... Else ... End If blocks are a bit muddled. The logic should be If (case is true) Then do some code Else case is false, so do some other code End If. Again, I've tried to re-write your code to give you examples of this.
You are confusing looping through a Range and looping through an Array. In your code you have set the limits of the Range as 4 - FinalRow. However, this does not mean your arrays have been set to the same dimensions. Most likely, your arrays start from 0 and go to FinalRow - 4. You need to be clear about these dimensions before looping.
As Mark Fitzgerald mentions, you need to dimension your array before using it. If it's an initial dimension then you could just use Redim. If you want to increase the array's dimension whilst retaining existing values then use Redim Preserve. I've tried to give you an example of both in the code below.
Okay, so onto your code...
With the looping, array size and If mistakes, it's rather difficult to see what you're trying to do. I think you might be trying to read all the customer IDs, writing them into a unique list and then summing all the values that match each ID. The code below does that. It's not the quickest or best way, but I've tried to write the code so that you can see how each of the errors above should work. I guess it doesn't matter if I'm up the wrong path as the main aim is to give you an idea of how to manage arrays, loops and Ifs. I hope your custID and amtPur are genuinely Longs - if, for example, amtPur stands for 'amount purchased' and is, in fact, a decimal number then this code will throw and error, so make sure your values and declarations are of the same type. Your commenting etiquette is a little esoteric but I've still followed it.
Good luck with your project and keep at it. I hope this helps you:
'-------------Declarations-------------------
Dim dataSht As Worksheet
Dim resultsSht As Worksheet
Dim custData As Variant
Dim uniqueIDs() As Long
Dim summaryData() As Long
Dim counter As Integer
Dim isUnique As Boolean
Dim rng As Range
Dim i As Integer
Dim j As Integer
'-------------Get All the Data-------------------
Set dataSht = ThisWorkbook.Sheets("Data")
Set resultsSht = ThisWorkbook.Sheets("Results")
With dataSht
Set rng = .Range(.Cells(4, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Resize(, 2)
End With
custData = rng.Value2 'writes worksheet to variant array
'-------------Loop through the data to find number of unique IDs----
For i = 1 To UBound(custData, 1)
isUnique = True
If i = 1 Then
'First iteration so set the counter
counter = 0
Else
'Subsequent iterations so check for duplicate ID
For j = 1 To counter
If uniqueIDs(j) = custData(i, 1) Then
isUnique = False
Exit For
End If
Next
End If
'Add the unique ID to our list
If isUnique Then
counter = counter + 1
ReDim Preserve uniqueIDs(1 To counter)
uniqueIDs(counter) = custData(i, 1)
End If
Next
'-------------Aggregate the amtPur values----
ReDim summaryData(1 To counter, 1 To 2)
For i = 1 To counter
summaryData(i, 1) = uniqueIDs(i)
'Loop through the data to sum the values for the customer ID
For j = 1 To UBound(custData, 1)
If custData(j, 1) = uniqueIDs(i) Then
summaryData(i, 2) = summaryData(i, 2) + custData(j, 2)
End If
Next
Next
'-----------Outpute the results to the worksheet----
Set rng = resultsSht.Cells(4, 1).Resize(counter, 2)
rng.Value = summaryData