Pick random numbers from a list and then delete chosen numbers and pick again from remaining list.

[ddander54]

I have some code (thanks to the author) that picks a list of random numbers in Col A (Starts in A6) and puts (copy) the list in Col D (Starts in D6), which works great. However there are 2 tweaks that I would like to make in the code...
1) instead of just copying the value in Col A to Col D, I would like to copy Col A:C to Col D:F,
2) and since I need to run the macro again, I need to get a new list that doesn't have the numbers in it from the first time it ran, so each time I run the macro, I need to clear the chosen numbers in Col A that were a Match to Col D.

So to reiterate...
Row 5 is the header row
Row 6 starts the data rows
Col A:C is the big list
Col A is a number, B:C are text
Col D is where the random list gets generated
Would like Col A:C to be generated in Col D:F
Would like Row (only Col A:C) to be cleared if Col D number matches Col A number.

Hope that makes sense.....

Here is the code I'm using:

Sub PickNamesAtRandom()
Dim HowMany As Integer
Dim NoOfNames As Long
Dim RandomNumber As Integer
Dim Names() As String 'Array to store randomly selected names
Dim i As Byte
Dim CellsOut As Long 'Variable to be used when entering names onto worksheet
Dim ArI As Byte 'Variable to increment through array indexes
Worksheets("PPM").Range("D:D").ClearContents
Application.ScreenUpdating = False
HowMany = Range("F1").Value
CellsOut = 6
ReDim Names(1 To HowMany) 'Set the array size to how many names required
NoOfNames = Application.CountA(Range("A:A")) - 1 ' Find how many names in the list
i = 1
Do While i <= HowMany
RandomNo:
    RandomNumber = Application.RandBetween(2, NoOfNames + 1)
    'Check to see if the name has already been picked
    For ArI = LBound(Names) To UBound(Names)
        If Names(ArI) = Cells(RandomNumber, 1).Value Then
            GoTo RandomNo
        End If
    Next ArI
    Names(i) = Cells(RandomNumber, 1).Value ' Assign random name to the array
    i = i + 1
Loop
'Loop through the array and enter names onto the worksheet
For ArI = LBound(Names) To UBound(Names)
    Cells(CellsOut, 4) = Names(ArI)
    CellsOut = CellsOut + 1
Next ArI
 
Application.ScreenUpdating = True
End Sub

Thanks in Advance,
Don