Macro, if cell is empty, display a message + stop execution.

Hello,
1- if all your cells are contiguous, you can use the syntax: Range("A1:A10").
In your example:
Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15")
is more advantageously written as:
Range("D3:D15")

2- for your test:
You need to create a loop over this Range.
You can proceed like this, add this code at the beginning of your macro:

Dim MaPlage As Range, Cel As Range Set MaPlage = Sheets("ajout_produit_composant").Range("D3:D15") For Each Cel In MaPlage 'for all the cells in the range If Cel.Value = "" Then 'if it is empty then 'message to the user MsgBox "The cell: " & Cel.Address & " is not filled in." 'exit the procedure Exit Sub End If Next

Best regards,
Franck P

Thank you pijaku for your response, that's exactly it.

As for the syntax, it's true that mine was a bit cumbersome. I've modified it accordingly, given that the different questionnaires I had to create are not always contiguous.

To accomplish the same work for the G cells, I added another loop afterward.
I tried using Range("D3:D15;G3:G16") but it didn't work.

Thank you for sharing your knowledge, pijaku. Have a good day! :).

Final Macro:

Sub ajouter_un_produit()

Dim MaPlage As Range, Cel As Range

Set MaPlage = Sheets("ajout_produit_composant").Range("D3:D15")
For Each Cel In MaPlage 'for all the cells in the range
If Cel.Value = "" Then 'if it is empty then
'message to the user
MsgBox "The cell: " & Cel.Address & " is not filled in."
'exit the procedure
Exit Sub
End If
Next

Set MaPlage = Sheets("ajout_produit_composant").Range("G3:G15")
For Each Cel In MaPlage 'for all the cells in the range
If Cel.Value = "" Then 'if it is empty then
'message to the user
MsgBox "The cell: " & Cel.Address & " is not filled in."
'exit the procedure
Exit Sub
End If
Next

Application.ScreenUpdating = False
Sheets("ajout_produit_composant").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15").Copy
Set Derligne = Sheets("tableau").Range("$A$65536").End(xlUp).Offset(1, 0)
Derligne.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
Application.ScreenUpdating = False
Sheets("ajout_produit_composant").Range("G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").Copy
Set Derligne = Sheets("tableau").Range("$A$65536").End(xlUp).Offset(0, 13)
Derligne.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
Sheets("ajout_produit_composant").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15,G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").ClearContents
Application.CutCopyMode = False

End Sub

Hello

Here is your modified macro
To be tested of course

Sub add_a_product()
Application.ScreenUpdating = False
With Sheet2
For L = 3 To 13
If .Range("D" & L).Value = "" Then
MsgBox "Please answer all the questions"
Exit Sub
End If
Next
For L = 3 To 16
If .Range("G" & L).Value = "" Then
MsgBox "Please answer all the questions"
Exit Sub
End If
Next
.Range("D3:D15").Copy
LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
Sheet1.Range("A" & LastRow).PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
.Range("G3:G16").Copy
LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
Sheet1.Range("A" & LastRow).PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
.Range("D3:D15").ClearContents
.Range("G3:G16").ClearContents
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

See you soon

Maurice

Thank you Maurice, I couldn't test the effect because even after filling out my questions, the message box remains and the macro doesn't run.