Random number in every other cell paired then sort.

[noveske]

Currently this code generates 16 numbers and places them in C4:C19.
How would I set it to every other?
So instead of every cell in the column, I just need it to generate in every other, C4, C6, C8, C10, C12, C14, C16, C18.
Tried setting that as range, but would halt at sort. Also tried offsetting. I think I was off.
Then I'm trying to make it every other match in pairs. So C5=C4, C7=C6, C9=C8, C11=C10, C13=C12, C15=C14, C17=C16, C19=C18.
Then sort.

Only way I can think of is to generate and sort on another sheet, then reference to that page. Then hide the page of values?

Random - Copy.xlsm

Microsoft Excel Workbook

1drv.ms

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r&, k&, lim1&, lim2&, lim3&, arr(1 To 16, 1 To 1)
Dim dic1 As Object: Set dic1 = CreateObject("Scripting.dictionary")
Dim dic2 As Object: Set dic2 = CreateObject("Scripting.dictionary")
If Intersect(Target, Union(Range("E2"), Range("A2"))) Is Nothing Then Exit Sub
If Target.Address(0, 0) = "A2" Then
    Range("A4:A19").Value = Range("A2").Value
Else
    If Target.Value = "R" Then
        lim1 = 36: lim2 = 44: lim3 = 75
    Else
        lim1 = 32: lim2 = 33: lim3 = 64
    End If
    Randomize
    Do
        r = Int(Rnd() * lim1) + 1
        If Not dic1.exists(r) Then
            k = k + 1
            dic1.Add r, ""
            arr(k, 1) = r
        End If
    Loop Until k = 8
    Do
        r = Int(Rnd() * lim3) + 1
        If Not dic2.exists(r) And r >= lim2 Then
            k = k + 1
            dic2.Add r, ""
            arr(k, 1) = r
        End If
    Loop Until k = 16
    With Range("C4:C19")
        .Value = arr
        .Sort Range("C3")
    End With
End If
End Sub

Currently:

Trying to get it to:

 

[DanteAmor]

So C5=C4, C7=C6, C9=C8, C11=C10, C13=C12, C15=C14, C17=C16, C19=C18.

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r&, k&, lim1&, lim2&, lim3&, arr(1 To 16, 1 To 1)
Dim dic1 As Object: Set dic1 = CreateObject("Scripting.dictionary")
Dim dic2 As Object: Set dic2 = CreateObject("Scripting.dictionary")
Dim i As Long

If Intersect(Target, Union(Range("E2"), Range("A2"))) Is Nothing Then Exit Sub
If Target.Address(0, 0) = "A2" Then
    Range("A4:A19").Value = Range("A2").Value
Else
    If Target.Value = "R" Then
        lim1 = 36: lim2 = 44: lim3 = 75
    Else
        lim1 = 32: lim2 = 33: lim3 = 64
    End If
    Randomize
    Do
        r = Int(Rnd() * lim1) + 1
        If Not dic1.exists(r) Then
            k = k + 1
            dic1.Add r, ""
            arr(k, 1) = r
        End If
    Loop Until k = 8
    Do
        r = Int(Rnd() * lim3) + 1
        If Not dic2.exists(r) And r >= lim2 Then
            k = k + 1
            dic2.Add r, ""
            arr(k, 1) = r
        End If
    Loop Until k = 16
    With Range("C4:C19")
        .Value = arr
        .Sort Range("C3")
        For i = 5 To 19 Step 2
          Range("C" & i).Value = Range("C" & i - 1).Value
        Next
    End With
End If
End Sub

 

[Peter_SSs]

Some general comments about your original code

• You really should be disabling events when you are putting values back into the worksheet. Otherwise the Worksheet_Change event is being needlessly retriggered and run.
• Not sure why you introduced two dictionaries. As there will never be any overlap between the lower range of numbers and the higher range, the first dictionary could simply have the new higher range values added to it.
• Seems a waste to generate 16 values only to then remove half of them.
• The two 'Do' loops are pretty similar so an option might be to combine them

Here is a slightly different approach that you could consider. It also addresses the above points.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r&, k&, lim1&, lim2&, lim3&
  Dim AL As Object
   
  If Intersect(Target, Union(Range("E2"), Range("A2"))) Is Nothing Then Exit Sub
  Application.EnableEvents = False
  If Target.Address(0, 0) = "A2" Then
    Range("A4:A19").Value = Range("A2").Value
  Else
    Set AL = CreateObject("System.Collections.ArrayList")
    lim1 = 32: lim2 = 33: lim3 = 64
    If Target.Value = "R" Then
      lim1 = 36: lim2 = 44: lim3 = 75
    End If
    Randomize
    Do
      r = IIf(k < 4, Int(Rnd() * lim1) + 1, Int(Rnd() * (lim3 - lim2 + 1)) + lim2)
      If Not AL.Contains(r) Then
        k = k + 1
        AL.Add r: AL.Add r
      End If
    Loop Until k = 8
    AL.Sort
    Range("C4:C19").Value = Application.Transpose(AL.ToArray)
  End If
  Application.EnableEvents = True
End Sub

 

[noveske]

    If Target.Value = "R" Then
        lim1 = 36: lim2 = 44: lim3 = 75

What would the limiting of numbers fall under? I couldn't find anything doing a search.
Trying to figure out a way to skip and also set ranges.

Like If "X" Then
Generate 5:10, 12:32. Basically blocking out certain numbers.

 

[Peter_SSs]

I'm not sure what you are asking.
You seemed to be using lim1, lim2 and lim3 to set the ranges. I tried to do the same thing.

1. Did my code work for the scenarios that you asked about originally?
2. Have the requirements now changed? Is it just that the first range might not start at 1?
3. Is there always just two ranges?
4. Is there always exactly 16 rows to generate?

 

[noveske]

I'm not sure what you are asking.
You seemed to be using lim1, lim2 and lim3 to set the ranges. I tried to do the same thing.

1. Did my code work for the scenarios that you asked about originally?
2. Have the requirements now changed? Is it just that the first range might not start at 1?
3. Is there always just two ranges?
4. Is there always exactly 16 rows to generate?

1. It did. Thank you.
2. Not really changed, but the ranges need adjusted.
3. Sometimes up to 4. But I figured when ranges change, I could just do them on separate sheets.
4. There will always be 16 rows. 8 numbers.

It's modifying the ranges. More parameters. Like the picture below. "A" has 2 different ranges. "B" has 4.

I understand lim1 limits 1-21. lim2 begins the new second range. lim3 ends the range.
So if the range for "A" starts at 5 ends at 33, then starts again at 44 and ends at 75... I'm not understanding how to code that.

If Target.Value = "A" Then
lim1 = (5:33): lim2 = 44: lim3 = 75

Then for B, it's just different ranges. It's 4 cells per range. 2 numbers are generated per range.

Else
    Set AL = CreateObject("System.Collections.ArrayList")
    lim1 = 32: lim2 = 33: lim3 = 64
    If Target.Value = "R" Then
      lim1 = 36: lim2 = 44: lim3 = 75
    End If
    Randomize

 

[Peter_SSs]

Not sure that I have fully understood but test this with a copy of your worksheet. Limits are set in the Select Case block in the code.
The overlapping lower/upper limit ranges means that the sorting can't be just done at the end but instead of starting from scratch I have used the basis of my earlier code.
I have assumed that the values in each group should be sorted in that group of rows.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r&, k&, i&, perGroup&
  Dim AL As Object
  Dim vLimits As Variant
  
  If Intersect(Target, Union(Range("E2"), Range("A2"))) Is Nothing Then Exit Sub
  Application.EnableEvents = False
  If Target.Address(0, 0) = "A2" Then
    Range("A4:A19").Value = Range("A2").Value
  Else
    Set AL = CreateObject("System.Collections.ArrayList")
    Select Case Target.Value
      Case "A": vLimits = Split("5 36 44 75")           '<-Set lower & upper limits for 'special' letter
      Case "B": vLimits = Split("2 32 1 32 1 31 1 30")  '<-Set lower & upper limits for 'special' letter
      Case "R": vLimits = Split("1 36 44 75")           '<-Set lower & upper limits for 'special' letter
      Case Else: vLimits = Split("1 32 33 64")  '<-Set lower & upper limits for everything else
    End Select
    perGroup = 16 / (UBound(vLimits) + 1)
    Randomize
    Do
      r = Int(Rnd() * (vLimits(k + 1) - vLimits(k))) + vLimits(k)
      If Not AL.Contains(r) Then
        AL.Add r: AL.Add r
        i = i + 1
        If i = perGroup Then
          i = 0
          k = k + 2
        End If
      End If
    Loop Until AL.Count = 16
    With Range("C4:C19")
      .Value = Application.Transpose(AL.ToArray)
      For i = 1 To 16 Step perGroup * 2
      .Cells(i).Resize(perGroup * 2).Sort Key1:=.Cells(i), Order1:=xlAscending, Header:=xlNo
      Next i
    End With
  End If
  Application.EnableEvents = True
End Sub