'Creating an array and pasting to set cols in VBA
I wanted to try to create an array in VBA and paste it to back into another sheet in the same workbook. I need an array of 50 random integer values, these 50 values need to come from 4 different sources, Source A = 15 values, Source B = 15 Values, Source C = 10 values, Source D = 10 Values. If the array cannot be filled to 15 or 10 by the source, I would like to fill what is left with source A. Here is some of the sample data i have
Sample Data 'This is redundant and can be replicated to create up to 50 entries, but the logic will stem from these entries.
Name Number Source
Bill 123456789 Type A
Bill 213456789 Type B
Bill 313456789 Type C
Bill 413456789 Type D
...
...
...
Mary 231234567 Type A
Mary 231234567 Type B
Mary 231234567 Type C
...
...
...
Tom 234567891 Type A
...
...
...
Sub RandomNumberGen()
'Create Arrays for each type of inspections
Dim TypeAArray() As Variant
Dim TypeBArray() As Variant
Dim TypeCArray() As Variant
Dim TypeDArray() As Variant
'Set Arrays range
Dim my_OverRange As Range
LastRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
Set my_TypeARange = Sheets("Sheet2").Range("C2:C" & LastRow)
ReDim ColumnOverArray(LastRow) 'Re size your array to fit data
ColumnOverArray = my_TypeARange 'add data to array
'Create loop to cycle through arrays and gather Random values?
'This is where im at so far. Im able to create an array and
'paste back into excel. Either i need to run a loop to cycle
'through or create 3 more arrays and get random values from the
'ranges.
MyTypeARange().Value = MyTypeARange.Random(15)
MyTypeBRange().Value = Random(15)
MyTypeCRange().Value = Random(10)
MyTypeDRange().Value = Random(10)
'Paste Random Values into sheet
My end result should look something like this.
Number Source
123456789 Type A
...
...
...
123456789 Type B
...
...
...
123456789 Type C
...
...
...
123456789 Type D
...
...
...
Solution 1:[1]
Please, test the next code. It will randomly extract elements from the ranges (to be larger than 15) in columns "C", "E", "G" and "J" and placed them in the four arrays you used in your code, but differently dimensioned. These four arrays are placed in a jagged array (an array of arrays) and randomly loaded. The code stops after each array has been processed and visually show in Immediate Window (being in VBE, Ctrl + G). Please, press F5 after each such stop. The content of each array will be dropped in A:A, one on top of the other:
Sub ExtractUniqueRndNumbersFromRanges()
Dim sh As Worksheet, lastRow As Long, arrInit, rndNo As Long
Dim TypeAArray(1 To 15, 1 To 1) As Variant, TypeBArray(1 To 15, 1 To 1)
Dim TypeCArray(1 To 10, 1 To 1) As Variant, TypeDArray(1 To 10, 1 To 1) As Variant
Dim jagArr, colsArr, filt As String, ii As Long, i As Long, lastERA As Long
jagArr = Array(TypeAArray, TypeBArray, TypeCArray, TypeDArray) 'create a jagged array (an array of arrays)
colsArr = Array("C", "E", "G", "J") 'create an array of columns used to extract random elements
Set sh = Sheets("Sheet2") 'it may be any sheet
sh.Range("A:A").ClearContents 'in order to repeat the code if some modifications needed
For ii = 0 To UBound(jagArr) 'iterate between the arrays of the jagged array
lastRow = sh.cells(sh.rows.count, colsArr(ii)).End(xlUp).Row 'last row
arrInit = Application.Transpose(sh.Range(colsArr(ii) & "2:" & colsArr(ii) & lastRow).value) 'create a 2D array from the range
For i = 1 To UBound(jagArr(ii))
Randomize
rndNo = Int((UBound(arrInit) - LBound(arrInit) + 1) * Rnd + LBound(arrInit))
jagArr(ii)(i, 1) = arrInit(rndNo) 'fill the A array with the random array elemengt
filt = arrInit(rndNo) & "$$$": arrInit(rndNo) = filt 'make the array element unique, to be removed
arrInit = filter(arrInit, filt, False) 'eliminate the already extracted number
Next i
Debug.Print Join(Application.Transpose(jagArr(ii)), "|"): Stop 'visually check the filled array content in Immediate Window
lastERA = sh.Range("A" & sh.rows.count).End(xlUp).Row + 1 'last empty row in A:A
sh.Range("A" & lastERA).Resize(UBound(jagArr(ii)), 1).value = jagArr(ii)
Next ii
End Sub
Please, test it and send some feedback.
If something not clear, do not hesitate to ask for clarifications.
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|---|
| Solution 1 | FaneDuru |
