Shuffle this array, or else, fix my randomisation...

I have a macro that creates an array, populates it with random numbers then dumps it into a sheet.

Its quite large, and I'm seeing obvious patterns in the output, so doesn't look remotely random... I've added a test workbook, but depending on PC spec, might not run in a friendly manner... Be warned. Iv'e cut it down as small as I can to be able to see the results... my actual scrip populates 333x333 cells, this does 50x50

My question is either...

Can someone spot anything in my code that would make this more random

OR

Can I shuffle the array a few times after it's created, so add some more "randomness" to it?


This code was created from tutorials and forum posts, I'm "OK" at vba, but quite novice.

Sub MAP_CREATOR()

    Dim MapArray() As Integer                                               ' Tried as Byte, didn't work...
    Dim SysType As Byte
    Dim TheRange As Range
    Dim CellsDown As Long, CellsAcross As Long
    
    Randomize
    
    Worksheets("MAP_VISUAL").Activate
    
    'Turn off Application updates, calculations, and events
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    '   Set these to the size of my map
    CellsDown = 333
    CellsAcross = 333
    
    '   Redimension temporary array
    ReDim MapArray(1 To CellsDown, 1 To CellsAcross)
     
    '   Set worksheet range
    Set TheRange = Range(Cells(1, 1), Cells(CellsDown, CellsAcross))
    
    For AR = 1 To CellsDown
        For AC = 1 To CellsAcross
            Randomize
            MapArray(AR, AC) = Int((12001 - 1 + 1) * Rnd + 1)
        Next AC
    Next AR
    
    With Range("A1")
        .CurrentRegion.ClearContents
        .Resize(CellsDown, CellsDown) = MapArray
   End With
    
    'TheRange.Value = MapArray
    'Worksheets("MAP").Range("A1:CV100").Value = MapArray
    
    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

Many thanks in advance for anyones time and help, regardless of whether it solves my issue.