Sub FillRandomizeValues()
Dim wsh As Worksheet
Dim rng As Range
Dim colValues As New Collection
Dim bFilled As Boolean
Dim dblVal1 As Double, dblVal2 As Double, dblResult As Double
Set wsh = ActiveSheet
For Each rng In Intersect(wsh.Range("A:A"), wsh.UsedRange).Cells
If Not IsEmpty(rng.Value) Then
colValues.Add rng.Value, rng.Address
End If
Next
For Each rng In Intersect(wsh.Range("A:A"), wsh.UsedRange).Cells
If IsEmpty(rng.Value) Then
dblVal1 = colValues.Item(IIf(colValues.Item(1) > colValues.Item(2), 2, 1))
dblVal2 = colValues.Item(IIf(colValues.Item(1) > colValues.Item(2), 1, 2))
rng.Value = (Rnd() * (dblVal2 - dblVal1)) + dblVal1
bFilled = True
Else
If bFilled Then
colValues.Remove (1)
bFilled = False
End If
End If
Next
End Sub