Sub ClickAdd()
Dim rngAvailable As Range, rngCell As Range
If Range("F4") = "y" Then 'case sensitive
  Set rngAvailable = ThisWorkbook.Worksheets("Sheet1").Range("B18:B40")
  For Each cll In Range("A4:C4,I4:Q4").Cells
    If Application.WorksheetFunction.CountIf(rngAvailable, cll.Value) = 0 Then
      If Application.WorksheetFunction.CountBlank(rngAvailable)  0 Then
        rngAvailable.SpecialCells(xlCellTypeBlanks)(1) = cll.Value
      Else
        MsgBox "Ran outta spaces... couldn't place " & cll.Value & " from " & cll.Address & vbLf & "Stopping.", 0, ""
        Exit Sub
      End If
    End If
  Next cll
End If
End Sub