Error Message

[rubinda]

I have the following code below, but I am not having any luck applying code that will do the following: If the cell in column E states, “Complete” and there is no associated date in column F, I’d like an error message to pop up and not allow the data to be transferred/deleted. Can you please assist?

Sub LaPorte()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("La Porte").UsedRange.Rows.Count
J = Worksheets("La Porte-Closed").UsedRange.Rows.<wbr>Count
If J = 1 Then
If Application.WorksheetFunction.<wbr>CountA(Worksheets("La Porte-Closed").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("La Porte").Range("E1:E" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Complete" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("La Porte-Closed").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Complete" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True

ActiveWorkbook.Save

[TABLE="width: 0"]
<tbody>[TR]
[TD][TABLE="width: 0"]
<tbody>[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]
[/TD]
[/TR]
[TR]
[TD]

[/TD]
[/TR]
[TR]
[TD]

[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]

[/TD]
[/TR]
</tbody>[/TABLE]

​

 

[Fluff]

How about

Sub LaPorte()
   Dim Mws As Worksheet
   Dim Cws As Worksheet
   Dim i As Long

   Set Mws = Worksheets("pcode")
   Set Cws = Worksheets("sheet1")
   
   For i = Mws.Range("E" & Rows.Count).End(xlUp).row To 1 Step -1
      If Range("E" & i).Value = "Complete" And IsDate(Range("F" & i).Value) Then
         Rows(i).Copy Cws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         Rows(i).Delete
      End If
   Next i
End Sub

 

[rubinda]

Where would I enter the pop up message? It does not allow the macro to work if there is no date in column F, but I am trying to enter a pop up message to notify the user. Thank you for the help!

 

[Fluff]

How about

   For i = Mws.Range("E" & Rows.Count).End(xlUp).row To 1 Step -1
      If Range("E" & i).Value = "Complete" And IsDate(Range("F" & i).Value) Then
         Rows(i).Copy Cws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         Rows(i).Delete
      Else
         MsgBox "There is no dat in cell F" & i
      End If
   Next i

 

[rubinda]

This is great! One more question...

All cells in Row 1 are headings. How do I get the macro to not look at row 1 (or F1 for a date if column E states "Complete")?

 

[Fluff]

Make this change

 For i = Mws.Range("E" & Rows.Count).End(xlUp).row To [COLOR=#ff0000]2[/COLOR] Step -1