Help needed with VBA array code

Sub test()  
    
 Dim c As Range  
 Dim r As Range  
 Dim wb As Workbook  
 Dim ws As Worksheet  
 Dim arr() As String  
 Set wb = ActiveWorkbook  
 Set r = wb.Sheets("Data").Range("C2:C16")  
 ReDim arr(0 To 0)  
 'Get Unique Values and new sheets  
 For Each c In r  
     If Not CheckArray(c.Value, arr) Then  
         arr(UBound(arr)) = c.Value  
         ReDim Preserve arr(LBound(arr) To UBound(arr) + 1)  
         Set ws = wb.Sheets.Add  
         ws.Name = CStr(c.Value)  
     End If  
     c.EntireRow.Copy Sheets(CStr(r.Value)).Cells.SpecialCells(11)(2).EntireRow  
    
     ws.Paste ws.Range("A1").SpecialCells(xlLastCell).Offset(1, 0)  
 Next c  
 End Sub  
    
 Function CheckArray(Value As String, MyArray() As String) As Boolean  
 Dim i As Integer  
 For i = LBound(MyArray) To UBound(MyArray)  
     If MyArray(i) = Value Then  
         CheckArray = True  
         Exit Function  
     End If  
 Next i  
 CheckArray = False  
 End Function