Te propongo lo siguiente, en la hoja en una columna debes tener la lista completa de los empleados, y en otras celdas el horario a asignar.
Por ejemplo:
Ahora ejecuta la siguiente macro:
Sub Asignar_Empleado_Libre()
'Por Dante Amor
'
Set h = Sheets("Hoja2")
Set rangoemp = h.Range("H2:H" & h.Range("H" & Rows.Count).End(xlUp).Row)
rangoemp.Offset(0, 1).Value = ""
ini = h.Range("E2")
fin = h.Range("F2")
'
Set r = h.Columns("C")
For Each empleado In rangoemp
nombre = empleado.Value
ocupado = False
Set b = r.Find(empleado.Value, LookAt:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If h.Cells(b.Row, "A").Value <= ini And _
h.Cells(b.Row, "B").Value >= ini Then
empleado.Offset(0, 1).Value = "No"
ocupado = True
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
If ocupado = False Then
empleado.Offset(0, 1).Value = "Si"
Exit For
End If
Next
MsgBox "Fin"
End Sub
Lo que hace la macro es revisar empleado por empleado, si el empleado está ocupado, pasa al siguiente empleado. Si encuentra un empleado que no está ocupado en el horario a asignar, entonces en la lista de empleados lo marca con un "Sí" como disponible y se detiene la macro:
En esta parte de la macro se sabe si el empleado está disponible:
If ocupado = False Then
empleado.Offset(0, 1).Value = "Si"
Exit For
End If
Dentro del If puedes agregar más código si lo necesitas, por ejemplo, si quieres que se agregue el empleado y el horario a las columnas A,B y C, sería algo así:
Sub Asignar_Empleado_Libre()
'Por Dante Amor
'
Set h = Sheets("Hoja2")
Set rangoemp = h.Range("H2:H" & h.Range("H" & Rows.Count).End(xlUp).Row)
rangoemp.Offset(0, 1).Value = ""
ini = h.Range("E2")
fin = h.Range("F2")
'
Set r = h.Columns("C")
For Each empleado In rangoemp
nombre = empleado.Value
ocupado = False
Set b = r.Find(empleado.Value, LookAt:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If h.Cells(b.Row, "A").Value <= ini And _
h.Cells(b.Row, "B").Value >= ini Then
empleado.Offset(0, 1).Value = "No"
ocupado = True
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
If ocupado = False Then
empleado.Offset(0, 1).Value = "Si"
u = h.Range("A" & Rows.Count).End(xlUp).Row + 1
h.Range("A" & u).Value = ini
h.Range("B" & u).Value = fin
h.Range("C" & u).Value = empleado.Value
Exit For
End If
Next
MsgBox "Fin"
End Sub
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta.
'.[Avísame cualquier duda