Macro, if cell is empty, display a message + stop execution.
Solved
Alexver
Posted messages
44
Status
Membre
-
Alexver Posted messages 44 Status Membre -
Alexver Posted messages 44 Status Membre -
```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
```
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 réponses
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:
Best regards,
Franck P
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
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
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