Option Explicit
Sub Random_Name()
Dim Names_Array() As Variant, Names_Needed As Long, Random_Number, Name_Count As Long, Index_Array() As Long, _
Final_Names_Array() As Variant, X1 As Long, Last_Row As Long, ws As Worksheet
Set ws = ActiveSheet
Last_Row = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Names_Needed = (Last_Row * 0.5) / 12 ' the number of names that month that need to be pulled randomly
Names_Array = ActiveSheet.Range("B2:B" & Last_Row).Value 'assumes data starts in row 2
ReDim Index_Array(1 To Names_Needed, 1 To 1) 'Will hold index numbers
ReDim Final_Names_Array(1 To Names_Needed, 1 To 1)
Name_Count = 1
Do While Name_Count <> Names_Needed 'While the Final array is not full
Random_Number = ((Names_Needed - 1 + 1) * Rnd + 1) 'Random number between 1 and the number of names that need to be pulled for that month
If IsInArray(Random_Number, Index_Array) = False Then 'No repeat names
Index_Array(Name_Count, 1) = Random_Number
Final_Names_Array(Name_Count, 1) = Names_Array(Index_Array(Name_Count, 1), 1)
Name_Count = Name_Count + 1
End If
Loop
ws.Range("D:D" & Names_Count + 1).Value = Final_Names_Array 'ACCOUNTING FOR HEADERS (+1)
End Sub
Public Function IsInArray(valToBeFound As Variant, ARR As Variant) As Boolean
'DEVELOPER: Ryan Wells (wellsr.com)
'DESCRIPTION: Function to check if a value is in an array of values
'INPUT: Pass the function a value to search for and an array of values of any data type.
'OUTPUT: True if is in array, false otherwise
Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
For Each element In ARR
If element = valToBeFound Then
IsInArray = True
Exit Function
End If
Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function
