Hello!

I'm trying to adapt a code I found on the internet. This code works like this.

-Each Excel cell consist of blank cells, special characters, integer and strings.
-first finds the last not empty cell. It then loop through all the cells.
-each row consists of dynamic cells. All cells that are full are transferred to the array by entering the loop.
-array is transferred to the ready code and shuffle and rewrite to cells.
-I'm getting this error here (Run-time error '9': Subscript out of range)
and somehow some data is lost

Here my code and excel file

Array Shuffle.xlsm

Thank you
Function Resample(data_vector() As Variant) As Variant()
    Dim shuffled_vector() As Variant
    shuffled_vector = data_vector
    Dim i As Long
    For i = UBound(shuffled_vector) To LBound(shuffled_vector) Step -1
        Dim t As Variant
        t = shuffled_vector(i)
        Dim j As Long
        j = Application.RandBetween(LBound(shuffled_vector), UBound(shuffled_vector))
        shuffled_vector(i) = shuffled_vector(j)
        shuffled_vector(j) = t

    Next i
    Resample = shuffled_vector
End Function

Sub PopulatingArray()

Dim myArray() As Variant
Dim rng As Range
Dim cell As Range
Dim x As Long

'Last Row
Lr = Cells(Rows.Count, 1).End(xlUp).Row

'Loop Each Row
For i = 1 To Lr
lCol = Cells(i, Columns.Count).End(xlToLeft).Column
Set rng = Range(Cells(i, 2), Cells(i, lCol))

    ReDim myArray(rng.Cells.Count)

'Populate Array
    For Each cell In rng.Cells
        myArray(x) = cell.Value
        Debug.Print myArray(x)
        x = x + 1
    Next cell
    
'call functiion
myArray = Resample(myArray)
rng.Value = myArray
Debug.Print Join(myArray, ",")
Next i
End Sub