My code have an error and I don't know why

Question

Hi I have the next code in VBA:

Sub EscribirPregunta()
    Dim preguntas As Range
    Dim pregunta As Range
    Dim boton As Button
    Dim preguntaSeleccionada As String
    Dim celdasLista As Range
    Dim celda As Range
    Dim ws As Worksheet
    
    ' Establecer el rango de las preguntas
    Set ws = ActiveSheet
    Set preguntas = ws.Range("C2:C23")
    
    ' Verificar si todas las celdas en B2:B23 contienen "1"
    Dim celdasB As Range
    Set celdasB = ws.Range("B2:B23")
    
    If Application.WorksheetFunction.CountIf(celdasB, 1) = celdasB.Count Then
        
        ' Borrar los "1" de la columna B
        celdasB.Value = ""
        
        Exit Sub
    End If
    
    ' Obtener el botón que activó la macro
    Set boton = ActiveSheet.Buttons(Application.Caller)
    
    ' Verificar si ya hay una pregunta en la celda destino
    If boton.TopLeftCell.Value <> "" Then
        Exit Sub ' Salir de la macro si ya hay una pregunta en la celda destino
    End If
    
    ' Crear un rango de las celdas de la lista (L2:L16) sin incluir la celda actual
    Set celdasLista = ws.Range("L2:L16")
    
    ' Filtrar las preguntas que no tienen un "1" en la columna B
    Dim preguntasFiltradas As String
    Dim preguntaRow As Integer
    
    preguntasFiltradas = ""
    preguntaRow = 0
    
    For i = 1 To preguntas.Count
        ' Seleccionar una pregunta aleatoria sin repetición de las preguntas filtradas
        Set pregunta = preguntas.Cells(Application.WorksheetFunction.RandBetween(1, preguntas.Count))
        
        'Comprobar que esa pregunta se haya utizado o no (visualizando si la columna B tiene 1)
        If ws.Cells(pregunta.Row, "B") <> 1 Then 'Si no se ha utilizado aun
            preguntaSeleccionada = pregunta.Value
            preguntaRow = pregunta.Row
            Exit For
        Else 'Si se ha utilizado
            preguntaSeleccionada = ""
            preguntaRow = 0
        End If
        
    Next
    
    ' Mostrar la pregunta seleccionada en la celda del botón
    ws.Cells(boton.TopLeftCell.Row, "L").Value = preguntaSeleccionada
    
    ' Obtener la celda correspondiente en la columna B
    Set celdaB = ws.Cells(preguntaRow, "B")
    
    ' Escribir "1" en la celda correspondiente en la columna B
    celdaB.Value = 1
End Sub

And in Set celdaB = ws.Cells(preguntaRow, "B") sometimes it give me error 1004. Why?

I try everything I know and I expected the reason why it work sometimes and sometimes no.

Answer 1

Here is another way of doing it:

Function EscribirPregunta()
    
    Dim celdasB As Range, rando As Long, f, ws As Worksheet, boton As Button
    Dim tlc As Range
    
    Set ws = ActiveSheet
    
    Set tlc = ws.Buttons(Application.Caller).TopLeftCell
    If Len(tlc.Value) > 0 Then Exit Function
    
    Set celdasB = ws.Range("B2:B23") 'range with "used" flag
    
    rando = Application.RandBetween(1, celdasB.Cells.Count)
    
    'find the first empty cell after cell # `rando`
    '   (Find always loops around after the last cell)
    Set f = celdasB.Find("", after:=celdasB.Cells(rando), lookat:=xlWhole, LookIn:=xlValues)
    If Not f Is Nothing Then
        'use the question from Col C
        tlc.EntireRow.Columns("L").Value = f.Offset(0, 1).Value
        f.Value = 1                       'flag as used
    Else
        celdasB.ClearContents             'all questions are used: reset
    End If
    
End Function