How do you skip prefilled cells and also fill in the blank cells with no duplicates?

Question

I am trying to skip cells that have prefilled data.

If I were to select a day of the week in my schedule certain people would have the day off.

I am trying to skip these specific cells that have the Xs.

The code fills the cells but it won't skip the cells that have the Xs.

The list is on a separate sheet.

Sub placements()
    Dim SrcRange As Range, FillRange As Range
    Dim c As Range, r As Long
    Dim rng As Range
    Dim BlankCells As Range

    Set SrcRange = Worksheets("Placements").Range("A2:A8")
    Set FillRange = Selection
    Set BlankCells = Selection.SpecialCells(xlCellTypeBlanks)
        
    If TypeName(Selection) <> "Range" Then Exit Sub
    Application.ScreenUpdating = False
    On Error Resume Next
    
    r = SrcRange.Cells.Count
    For Each c In FillRange
        Do
            c.Value = Application.WorksheetFunction.Index(SrcRange, Int((r * Rnd) + 1))
        Loop Until WorksheetFunction.Count(FillRange, c.Value, BlankCells) < 2
    Next
End Sub

Answer 1

Try this:

Sub placements()
    
    Dim FillRange As Range
    Dim c As Range, i As Long, arr
    
    'check a range is selected
    If TypeName(Selection) <> "Range" Then
        MsgBox "select a Column first", vbExclamation
        Exit Sub
    End If
    
    'find all blanks in the selection
    On Error Resume Next
    Set FillRange = Selection.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If FillRange Is Nothing Then
        MsgBox "No blanks selected!", vbExclamation
        Exit Sub
    End If
    
    'get codes and shuffle them
    arr = Application.Transpose(Worksheets("Placements").Range("A2:A8").Value)
    arr = ShuffleArray(arr)  'make a shuffled copy of the array
    
    i = LBound(arr)
    For Each c In FillRange.Cells
        c.Value = arr(i)
        i = i + 1         'next value from array
        If i > UBound(arr) Then
            MsgBox "Too many cells"
            Exit For
        End If
    Next c
    
End Sub

'shuffle an array and return the shuffled copy
Function ShuffleArray(arrIn)
    Dim N As Long, J As Long, Temp As Variant, arr()
    Randomize
    'make a copy of the array
    ReDim arr(LBound(arrIn) To UBound(arrIn))
    For N = LBound(arrIn) To UBound(arrIn)
        arr(N) = arrIn(N)
    Next N
    'shuffle the copy
    For N = LBound(arr) To UBound(arr)
        J = CLng(((UBound(arr) - N) * Rnd) + N)
        Temp = arr(N)
        arr(N) = arr(J)
        arr(J) = Temp
    Next N
    ShuffleArray = arr 'return the shuffled copy
End Function