Setting cell equal to random value if cell isn't blank in range

Question

At a high level I am trying to set a cell equal to a random cell within a range. The issue I am having is that in this range I want to pull a random Value from, the Value I am taking is the result of an 'if' expression that either sets the cell to a Value or "". So when I chose the random value I only want to choose cells that have an actual value, not the "".

Does anyone know how to get this expected behavior?

The code below shows what I have tried currently, each large block is commented to help with understanding. The block I need help with replaces the values in each column until the next cell is blank then moves to the next column.

upperBound = 1798
lowerBound = 2

Randomize

'This loop section populates the data area with a static value in cell 9,3 then 9,4 etc..
For j = 3 To 15
   val = Cells(9, j).Value
   For i = 1 To val
      Cells(12 + i, j).Value = Cells(9, j)
   Next i
Next j

'This loop section uses the cells already populated down each column and replaces that value with the random value from the other range
Dim x As Integer
' Set numrows = number of rows of data.
For j = 3 To 15
  NumRows = Range(Cells(13, j), Cells(13, j).End(xlDown)).Rows.Count
  ' Select cell 13,j.
  Cells(13, j).Select
  ' Establish "For" loop to loop "numrows" number of times.
  For x = 1 To NumRows
       ActiveCell.Value = Worksheets("2017 Role IDs").Cells(Int((upperBound - lowerBound + 1) * Rnd + lowerBound), 2).Value
     ' Selects cell down 1 row from active cell.
     ActiveCell.Offset(1, 0).Select
  Next
Next j

This is the data before the second block runs. I want to replace the values that just match the number in the second row with the random number in the range:

This is what I would like to look like:

But currently it looks like this because the random selector is taking blank values:

tigeravatar tigeravatar · Accepted Answer · 2019-06-04T17:11:54

Something like this should work for you:

Sub tgr()

    Dim wb As Workbook
    Dim wsNums As Worksheet
    Dim wsDest As Worksheet
    Dim aData As Variant
    Dim vData As Variant
    Dim aNums() As Double
    Dim aResults() As Variant
    Dim lNumCount As Long
    Dim lMaxRows As Long
    Dim lRowCount As Long
    Dim ixNum As Long
    Dim ixResult As Long
    Dim ixCol As Long

    Set wb = ActiveWorkbook
    Set wsNums = wb.Worksheets("2017 Role IDs")
    Set wsDest = wb.ActiveSheet

    With wsNums.Range("B2", wsNums.Cells(wsNums.Rows.Count, "B").End(xlUp))
        If .Row < 2 Then Exit Sub   'No data
        lNumCount = WorksheetFunction.Count(.Cells)
        If lNumCount = 0 Then Exit Sub  'No numbers
        ReDim aNums(1 To lNumCount)
        If .Cells.Count = 1 Then
            ReDim aData(1 To 1, 1 To 1)
            aData(1, 1) = .Value
        Else
            aData = .Value
        End If

        'Load populated numeric cells into the aNums array
        For Each vData In aData
            If Len(vData) > 0 And IsNumeric(vData) Then
                ixNum = ixNum + 1
                aNums(ixNum) = vData
            End If
        Next vData
    End With

    lMaxRows = Application.Max(wsDest.Range("C9:O9"))
    If lMaxRows = 0 Then Exit Sub   'Row count not populated in row 9 for each column
    ReDim aResults(1 To WorksheetFunction.Max(wsDest.Range("C9:O9")), 1 To 13)

    'Populate each column accordingly and pull a random number from aNums
    For ixCol = 1 To UBound(aResults, 2)
        If IsNumeric(wsDest.Cells(9, ixCol + 2).Value) Then
            For ixResult = 1 To CLng(wsDest.Cells(9, ixCol + 2).Value)
                Randomize
                aResults(ixResult, ixCol) = aNums(Int(Rnd() * lNumCount) + 1)
            Next ixResult
        End If
    Next ixCol

    wsDest.Range("C13").Resize(UBound(aResults, 1), UBound(aResults, 2)).Value = aResults

End Sub

Setting cell equal to random value if cell isn't blank in range

1 Answers