Does this work: Sheet roster contains a list of names in column A and random numbers in column B. Column B is randomized and Columns AB sorted on B. The template sheet is filled sequentially from the sorted list top down.
Option Explicit
Sub PairUp()
Dim PairRow As Variant, _
Ndx As Long, _
RowNum As Variant
PairRow = Array(5, 6, 9, 10, 13, 14, 17, 18, _
21, 22, 25, 26, 29, 30, 33, 34, _
38, 39, 42, 43, 46, 47, 50, 51, _
54, 55, 58, 59, 62, 63, 66, 67)
Call Sorter
For Each RowNum In PairRow
Ndx = Ndx + 2
With Sheets("template")
.Cells(RowNum, "B").Value = Sheets("roster").Cells(Ndx, 1).Value
.Cells(RowNum, "N").Value = Sheets("roster").Cells(Ndx + 1, 1).Value
End With
Next RowNum
End Sub
Sub Sorter()
Application.ScreenUpdating = False
Worksheets("roster").Calculate
With ActiveWorkbook.Worksheets("Roster").Sort
.SortFields.Clear
.SortFields.Add _
Key:=Range("B2:B65"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.SetRange Range("A1:B65")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub
Bookmarks