icemail
05-05-2021, 07:50 PM
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
:arrowr: 28409 :arrowl:
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
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
:arrowr: 28409 :arrowl:
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