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