Excel VBA Redim Preserve Out of range - vba

i am trying to redim and preserve my array but it keeps coming up with an error that says it is out of range i do not know why?
Dim FirstArray(0) As Variant
Dim SecondArray(0) As Variant
Dim ArrSize As Variant
row = 9
ArrSize = 1
Do While Not Cells(row, 3).Comment Is Nothing
FirstArray(ArrSize - 1) = Cells(row, 3).Value
ReDim Preserve FirstArray(ArrSize)
ArrSize = ArrSize + 1
row = row + 1
Loop


It should be:
Dim FirstArray() as Variant
Dim SecondArray() As Variant
I made the same mistake initially
To declare a variable array, you don't give it an initial size.
Also, make sure you ReDim it to 1 before you assign its 0 index a value.
ReDim Preserve FirstArray(ArrSize)
FirstArray(ArrSize - 1) = Cells(row, 3).Value
Hope this helps!


You could also use an ArrayList object which saves having to ReDim things. Also has added functionality (see here for example)
Dim FirstArray As Object
Set FirstArray = CreateObject("System.Collections.ArrayList")
row = 9
Do While Not Cells(row, 3).Comment Is Nothing
FirstArray.Add Cells(row, 3).Value
row = row + 1
Loop

Related

Initialize a list (or array) of a variable length

I know that we could declare a list of a fixed length in VBA by, eg, Dim result as Variant followed by ReDim result(1 to 10). But I have difficulty in declaring a list of a variable length in VBA.
For instance, given a list arr, I would like to create another list result that removes all the empty and 0. I have written a code as follows:
Dim result As Variant
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i) <> "" And arr(i) <> 0 Then
ReDim Preserve result(1 To UBound(result, 1) + 1)
result(UBound(result, 1)) = arr(i)
End If
Next i
This code does not run, because the length of result is not well initialised; and ReDim Preserve result(1 To UBound(result, 1) + 1) raises an error in the very beginning.
Does anyone know how to fix this code?
PS: If ReDim inside a loop causes a bad performance, could anyone suggest a better way to restructure the code?

Examining your code it looks like you are filtering arr to get result where result excludes values that are not "" or 0. If this is the case then arrays are the wrong approach. You should consider using a Collection, ArrayList or Scripting.Dictionary, preferably one of the latter two.
You can use ArrayLists in VBA if you add a reference to msCorlib.
You can use Scripting.Dictionary if you create a late bound object 'CreateObj("Scripting.DIctionary") or add a reference to the microsoft scripting runtime for 'new Scripting.DIctionary'.
The reason I would recommend ArrayList or Scripting.Dictionary over Collection is that both of these objects can return arrays of the items they hold, which can be very convenient if you are working with Excel.
The Arraylist version of you code would look like
Dim myAL as ArrayList
Set MyAL = New ArrayList
Dim myItem as variant
For each myItem in arr
If myItem<>"" and myItem<>0 then myAl.add myitem
Next
'If you need an array then
dim myResult as variant
myResult = myAl.toarray
The scripting dictionary version looks similar but requires a key for each item. In you case an autokey generated by using mySD.count would be fine.
Dim mySD as Scripting.Dictionary
Set MySL = New Scripting.Dictionary
Dim myItem as variant
For each myItem in arr
If myItem<>"" and myItem<>0 then mySD.add mySD.count,myitem
Next
'If you need an array then
dim myResult as variant
myresult = mySD.Items
FInally, if you know in advance that arr is composed entirely of string values, you could look at the VBA Filter function for onedimensional string arrays.

You can declare the largest possible size of the array (in this case, It would be UBound(arr, 1) assuming that LBound(arr, 1) is 1) outside of the loop first then resize it again at the end of the loop:
Dim result As Variant
ReDim result(1 to Ubound(arr, 1)) As Variant
Dim resultCount As Long
Dim i As Long
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i) <> "" And arr(i) <> 0 Then
resultCount = resultCount + 1
result(resultCount) = arr(i)
End if
Next i
ReDim Preserve result(1 to resultCount) As Variant

How about you find the first value and then do
result = Array(arr(I))?
I just checked in the immediate pannel ?UBound(Array()) gives -1, so
Dim result As Variant
result = Array()
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i) <> "" And arr(i) <> 0 Then
ReDim Preserve result(0 To UBound(result, 1) + 1)
result(UBound(result, 1)) = arr(i)
End If
Next i
should work with a 0-based "result" array or
Dim result As Variant
ReDim result(1 To 1)
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i) <> "" And arr(i) <> 0 Then
ReDim Preserve result(1 To UBound(result, 1) + 1)
result(UBound(result, 1)) = arr(i)
End If
Next i

Adding a dictionary to array

I'd like to go through list in Excel and assign the values to dictionary. The the dictionary will be put into list. This will happen until the cells in the column are blank. As a result of entire function, the array of dictionaries will be returned.
Function CreateArrayofDicts()
Dim catlist As Variant
Dim catparams() As Variant
Dim ChartParamsDict As Dictionary
Dim k As Long
catlist = ArrayProblemsCat()
i = 1
Do Until IsEmpty(Cells(i, 1))
Set ChartParamsDict = New Scripting.Dictionary
For j = 0 To UBound(catlist)
Debug.Print Cells(i, 1)
If Cells(i, 1) = catlist(j) Then
Debug.Print 5
ChartParamsDict.Add Key:="Cells(1,2)", Item:=Cells(i, 2)
ChartParamsDict.Add Key:="Cells(1,3)", Item:=Cells(i, 3)
ChartParamsDict.Add Key:="Cells(1,4)", Item:=Cells(i, 4)
ReDim Preserve catparams(k)
catparams(k) = ChartParamsDict ' issues is here
k = k + 1
Debug.Print ChartParamsDict
End If
Next j
i = i + 1
Loop
CreateArrayofDicts = catparams
End Function

Your are missing Set on the problem line.
Set catparams(k) = ChartParamsDict

Array - Subscript out of range in 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)

Writing from an array to a range

I am working on a list and doing all the calculations on VBA however when i want to write my list to the predefined range i get nothing. The following is a an example of the code i'm using. I am not posting the actual code because it's long however this example has the same problem.
Option Explicit
Sub readArray()
Dim CoGrade() As Variant
Dim LastRow As Integer
Dim NPSeQuedan() As Variant
Dim SeQuedanRng As Range
'erases information from arrays if there was any
Erase CoGrade
Erase NPSeQuedan
'-------------------------------------------------------------------------
'find the last row on the data i want to read
LastRow = Range("b10000").End(xlUp).Row
'the relevant data starts on row 34
ArrayRows = LastRow - 34 + 1
'redifines the variables with the total numbers of stocks in the portfolio
ReDim CoGrade(ArrayRows, 1)
ReDim NPSeQuedan(ArrayRows, 1)
'reads each relevant number into its proper variable
CoGrade = Range(Cells(34, 2), Cells(LastRow, 2))
'' test
Set SeQuedanRng = Range(Cells(34, 13), Cells(34 + ArrayRows - 1,
13))
For a = 1 To ArrayRows
NPSeQuedan(a, 1) = CoGrade(a, 1)
Next
SeQuedanRng.Value = NPSeQuedan
'''
end sub

Here is another solution (though #SJR 's idea of using 1-dimensional arrays is good). I added various points about your original code in the comments to the code:
Sub readArray()
Dim CoGrade As Variant 'Don't bother with ()
Dim LastRow As Long 'Integer risks overflow
Dim A As Long, ArrayRows As Long 'you use these -- so declare it
Dim NPSeQuedan As Variant 'etc.
Dim SeQuedanRng As Range
'erases information from arrays if there was any
'Erase CoGrade -- VBA is garbage collected and these have just been declared, so 100% pointless
'Erase NPSeQuedan
'-------------------------------------------------------------------------
'find the last row on the data i want to read
LastRow = Cells(Rows.Count, "B").End(xlUp).Row 'why hard-wire in 10000?
'the relevant data starts on row 34
ArrayRows = LastRow - 34 + 1
'redifines the variables with the total numbers of stocks in the portfolio
'ReDim CoGrade(ArrayRows, 1) -- pointless
ReDim NPSeQuedan(1 To ArrayRows, 1 To 1) 'this is important for what you are doing
'reads each relevant number into its proper variable
CoGrade = Range(Cells(34, 2), Cells(LastRow, 2)).Value
'' test
Set SeQuedanRng = Range(Cells(34, 13), Cells(34 + ArrayRows - 1, 13))
For A = 1 To ArrayRows
NPSeQuedan(A, 1) = CoGrade(A, 1)
Next
SeQuedanRng.Value = NPSeQuedan 'works now!
End Sub

You can do it like this, which incorporates several of the comments made by John Coleman.
Sub readArray()
Dim CoGrade As Variant
Dim LastRow As Long, ArrayRows as Long, a as Long
Dim NPSeQuedan() As Variant
Dim SeQuedanRng As Range
'find the last row on the data i want to read
LastRow = Range("b10000").End(xlUp).Row
'the relevant data starts on row 34
ArrayRows = LastRow - 34 + 1
'redifines the variables with the total numbers of stocks in the portfolio
ReDim NPSeQuedan(1 To ArrayRows)
'reads each relevant number into its proper variable
CoGrade = Range(Cells(34, 2), Cells(LastRow, 2))
Set SeQuedanRng = Range(Cells(34, 13), Cells(34 + ArrayRows - 1, 13))
For a = 1 To ArrayRows
NPSeQuedan(a) = CoGrade(a, 1)
Next
SeQuedanRng.Value = Application.Transpose(NPSeQuedan)
End Sub

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")