within my existing code, check for blank cells in certain rows. Ifblank, exit sub

I

ipisors

for any row where someone selects the word Completed which is in
column R, i want code to check the values of the other cells in the
row. most of them need to be non-blank. (and they have data
validation to take care of what goes there, already).

i already have this code below, and i want to change it a little so
that near the beginning, this check happens. if cells is blank,
msgbox user "You can't have a blank entry for cell" &
cell.reference.

If no cells are blank, I guess continue with an End If and my code
continues?


Sub Stage1Archive()
Dim varanswer As String
varanswer = MsgBox("You are going to move COMPLETED items to the next
stage." & " " & vbNewLine & " " & vbNewLine & "After this step, you
cannot edit any more information for each box (row)." & " " &
vbNewLine & " " & vbNewLine & "Continue?", vbYesNo, "MOVE DATA TO
NEXT STEP")
If varanswer = vbNo Then
Exit Sub
End If
With Sheets("Stage1")
Set rgFilter = .Range("a1:r" & .[a65536].End(xlUp).Row)
Set rgCopy = .Range("a2:r" & .[a65536].End(xlUp).Row)
End With
rgFilter.AutoFilter Field:=18, Criteria1:="Complete"
With Sheets("Stage2")
Set rgTarget = .Range("A" & .[a65536].End(xlUp).Row + 1)
rgCopy.Copy
rgTarget.PasteSpecial xlPasteValuesAndNumberFormats
Sheets("Stage2").Select
Cells.Select
Selection.ColumnWidth = 8.86
Cells.EntireColumn.AutoFit
With Selection.Font
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Font
.Name = "Microsoft Sans Serif"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A4").Select
End With

' GOES BACK TO THE SHEET THEY WERE WORKING AND DELETES THE "FOUND"
ITEMS OFF OF IT
With Sheets("Stage1")
rgCopy.EntireRow.Delete
rgFilter.Parent.AutoFilterMode = False
End With
Sheets("Stage1").Select
thankscompleted.Show
End Sub
 
D

Don Guillett

Without comment on your code. If this is inserted into the SHEET module and
you double click on any cel in column R and it contains "completed" then
each cell on the row will be checked. If an error is found the msgbox will
appear and the macro will end

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
mc = 4
If Target.Column <> mc Then Exit Sub
If UCase(Target) <> "COMPLETED" Then Exit Sub
For i = 1 To mc
If Len(Application.Trim(Cells(Target.Row, i))) < 1 Then
MsgBox "Cell " & Cells(Target.Row, i).Address & " must be filled"
Exit Sub
End If
Next i
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
ipisors said:
for any row where someone selects the word Completed which is in
column R, i want code to check the values of the other cells in the
row. most of them need to be non-blank. (and they have data
validation to take care of what goes there, already).

i already have this code below, and i want to change it a little so
that near the beginning, this check happens. if cells is blank,
msgbox user "You can't have a blank entry for cell" &
cell.reference.

If no cells are blank, I guess continue with an End If and my code
continues?


Sub Stage1Archive()
Dim varanswer As String
varanswer = MsgBox("You are going to move COMPLETED items to the next
stage." & " " & vbNewLine & " " & vbNewLine & "After this step, you
cannot edit any more information for each box (row)." & " " &
vbNewLine & " " & vbNewLine & "Continue?", vbYesNo, "MOVE DATA TO
NEXT STEP")
If varanswer = vbNo Then
Exit Sub
End If
With Sheets("Stage1")
Set rgFilter = .Range("a1:r" & .[a65536].End(xlUp).Row)
Set rgCopy = .Range("a2:r" & .[a65536].End(xlUp).Row)
End With
rgFilter.AutoFilter Field:=18, Criteria1:="Complete"
With Sheets("Stage2")
Set rgTarget = .Range("A" & .[a65536].End(xlUp).Row + 1)
rgCopy.Copy
rgTarget.PasteSpecial xlPasteValuesAndNumberFormats
Sheets("Stage2").Select
Cells.Select
Selection.ColumnWidth = 8.86
Cells.EntireColumn.AutoFit
With Selection.Font
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Font
.Name = "Microsoft Sans Serif"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A4").Select
End With

' GOES BACK TO THE SHEET THEY WERE WORKING AND DELETES THE "FOUND"
ITEMS OFF OF IT
With Sheets("Stage1")
rgCopy.EntireRow.Delete
rgFilter.Parent.AutoFilterMode = False
End With
Sheets("Stage1").Select
thankscompleted.Show
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro Error 1
Change code help 0
Code to copy and paste based on today's date 1
Autofill Error 4
Floating Bar Chart 1004 error 0
Macro Error in Command Button 4
Code issue 2
Superscrpts in Excel 2007 Text boxes 0

Top