ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   within my existing code, check for blank cells in certain rows. Ifblank, exit sub (https://www.excelbanter.com/excel-programming/428172-within-my-existing-code-check-blank-cells-certain-rows-ifblank-exit-sub.html)

ipisors

within my existing code, check for blank cells in certain rows. Ifblank, exit sub
 
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

Don Guillett

within my existing code, check for blank cells in certain rows. If blank, exit sub
 
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

"ipisors" wrote in message
...
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




All times are GMT +1. The time now is 07:42 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com