View original (French)

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

Solved
Alexver -  
```vba
Sub ajouter_un_produit()
Application.ScreenUpdating = False

' Vérification des cellules D et G
Dim cell As Range
For Each cell In Sheets("ajout_produit_composant").Range("D3:D15,G3:G16")
If IsEmpty(cell.Value) Then
MsgBox "Veuillez répondre à toutes les questions.", vbExclamation
Exit Sub
End If
Next cell

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

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
```

4 answers

  1.  pijaku Moderator
    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
    5
    1. Alexver Author
      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
      0
      1. pijaku Moderator
        Range("D3:D15,G3:G16")
        0
    2. foo
      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
      0
      1. Alexver Author
        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.
        0