Iterate through columns

[GetSmart]

I have a spreadsheet with a button that loops down a list of strings in a column F (the_col = 6) and outputs a randomized subset of the list based on a value entered in F1. The number of strings/cells is determined by the value in cell F42. If the value in cell F1 = 2, then it will return two random strings from the list, etc. I am able to run this script for multiple columns by copying and pasting the "process column F" part of the script for each of the other columns (and changing the range references as appropriate) but it is getting quite long and cumbersome for lots of columns.

What is the best way to streamline this to go to column W without pasting and tweaking the section 22 more times?

Private Sub CommandButton1_Click()
Dim xNumber As Integer, uL As Integer
Dim xNames As Long
Dim xRandom As Integer, the_col As Integer
Dim Array_for_Names() As String
Dim i As Byte
Dim CellsOut_Number As Long
Dim Ar_I As Byte
Application.ScreenUpdating = False
Worksheets("Sheet1").Range("A2:A100").ClearContents
CellsOut_Number = 2 'start output at row 2

'process column F
the_col = 6
xNumber = Range("F1").Value
uL = Range("F42").Value
If xNumber > 0 Then
ReDim Array_for_Names(1 To xNumber)
xNames = Application.CountA(Range("F3:F" & uL + 2)) 'column F list
j = 1
Do While j <= xNumber
RandomNo1:
xRandom = Application.RandBetween(3, xNames + 2) 'items start at row 3
'MsgBox xRandom
For Ar_I = LBound(Array_for_Names) To UBound(Array_for_Names)
If Array_for_Names(Ar_I) = Cells(xRandom, the_col).Value Then    'don't return duplicate values
GoTo RandomNo1
End If
Next Ar_I
Array_for_Names(j) = Cells(xRandom, the_col).Value   'populate the array
j = j + 1
Loop
For Ar_I = LBound(Array_for_Names) To UBound(Array_for_Names)
Cells(CellsOut_Number, 1) = Array_for_Names(Ar_I)   'output the list of random strings
CellsOut_Number = CellsOut_Number + 1
Next Ar_I
End If

Application.ScreenUpdating = True
End Sub

Thanks!

 

[GetSmart]

This is what the spreadsheet looks like for the first 3 sets of lists:

Clicking randomize runs the script.

 

[GetSmart]

I was able to figure it out changing the ranges to dynamic cell references:

Private Sub CommandButton1_Click()
Dim xNumber As Integer, uL As Integer, z As Integer
Dim xNames As Long
Dim xRandom As Integer, the_col As Integer
Dim Array_for_Names() As String
Dim i As Byte
Dim CellsOut_Number As Long
Dim Ar_I As Byte
Application.ScreenUpdating = False
Worksheets("Sheet1").Range("A2:A100").ClearContents
CellsOut_Number = 2 'start output at row 2

For z = 6 To 23  'loop through lists in columns 6 through 23
  the_col = z
  xNumber = Cells(1, z).Value
  uL = Cells(42, z).Value
  If xNumber > 0 Then
    ReDim Array_for_Names(1 To xNumber)
    xNames = Application.CountA(Range(Cells(1, z), Cells(uL + 2, z)))
    j = 1
Do While j <= xNumber
RandomNo1:
  xRandom = Application.RandBetween(3, xNames + 2) 'items start at row 3
For Ar_I = LBound(Array_for_Names) To UBound(Array_for_Names)
  If Array_for_Names(Ar_I) = Cells(xRandom, the_col).Value Then  'column f
    GoTo RandomNo1
  End If
Next Ar_I
Array_for_Names(j) = Cells(xRandom, the_col).Value
j = j + 1
Loop
For Ar_I = LBound(Array_for_Names) To UBound(Array_for_Names)
  Cells(CellsOut_Number, 1) = Array_for_Names(Ar_I)
  CellsOut_Number = CellsOut_Number + 1
Next Ar_I
End If
Next z
Application.ScreenUpdating = True
End Sub