PDA

View Full Version : Solved: Any better suggestions for checking cells before row move?



Simon Lloyd
05-24-2007, 03:44 AM
Hi all i have answered a post where the Op's asked if cells 1 - 50 in a row could be checked to make sure they are not blank before moving rows, heres the solution:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
Dim Ar As Integer
Dim Cel As Range
If Target.Row = 1 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
Ar = Target.Row
i = 1
For Each Cel In Range(Cells(Ar, 1), Cells(Ar, 50))
If WorksheetFunction.CountA(Cells(Ar, 1), Cells(Ar, 50)) > 0 Then
Else
MsgBox "you are at a new row, please click a cell in the row you were filling in and hit enter"
Exit Sub
End If
If Cel.Value = "" Then
MsgBox "you have left " & Cel.Address & " blank, please fill in before moving on!", vbOKOnly, "Missing Data"
Application.ScreenUpdating = False
Cel.Select
Exit Sub
Application.ScreenUpdating = True
End If
i = i + 1
If i > 50 Then Exit Sub
Next Cel
End Sub
A couple of problems, when attempting to move row they get the message box for the empty cell, it selects the empty cell and shows the message box again any way to combat that?, i did try IF Cel.Value="" Then Exit Subhowever if the moved to a different cell in a different row and it was blank then the validation for the previous row would not take place!

Any ideas?, have i missed a simple operation?

Bob Phillips
05-24-2007, 05:22 AM
Simon,

I am confused by what you are trying to do.

is it simply that you only want them to move a complete row?

If so, why not add a command button to do it?

Simon Lloyd
05-24-2007, 05:28 AM
No Bob, the ops wants them to fill in 50 cells in a row if they try to select a different row but have not filled all 50 in the row they are currently on he wanted them taken back to the cell not filled in before allowing them to move to another row, a kind of validation.

You know me and my explanations! why i'm almost a native Yank! Lol

Bob Phillips
05-24-2007, 05:43 AM
How about this



Private mPrevRow As Long
Private mPrevCol As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const NumCells As Long = 5
Dim i As Integer
Dim Ar As Integer
Dim Cel As Range
Dim nNonBlanks As Long

If Target.Row = 1 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub

If mPrevRow 0 Then
If mPrevRow Target.Row Then
i = 1
For Each Cel In Cells(mPrevRow, 1).Resize(, NumCells)
nNonBlanks = Application.CountA(Cells(mPrevRow, 1).Resize(, NumCells))
If nNonBlanks = NumCells Then

Exit For
ElseIf nNonBlanks = 0 Then

MsgBox "you are at a new row, please click a cell in the row you were filling in and hit enter"
Cells(mPrevRow, 1).Select
Exit For
ElseIf Cel.Value = "" Then

MsgBox "you have left " & Cel.Address & " blank, please fill in before moving on!", vbOKOnly, "Missing Data"
Cells(mPrevRow, mPrevCol).Select
Exit For
End If
i = i + 1
If i > NumCells Then Exit For
Next Cel
End If
End If
mPrevRow = Target.Row
mPrevCol = Target.Column
End Sub

malik641
05-24-2007, 05:52 AM
Just curious, if you're going to check if all 50 rows are not blank before doing anything...why not check:


' (as an example)
If Application.WorksheetFunction.CountA(Range("A1:A50")) < 50 Then Exit Sub


Before continuing the code?

Simon Lloyd
05-24-2007, 05:52 AM
Might be me Bob but the above appears to do nothing!

Simon Lloyd
05-24-2007, 05:53 AM
Not 50 rows 50 cells in current row before being allowed to move rows

malik641
05-24-2007, 05:57 AM
Not 50 rows 50 cells in current row before being allowed to move rows
Still...why not check that first?


If Application.Worksheetfunction.CountA(Range("A1:AX1")) < 50 Then Exit Sub

Charlize
05-24-2007, 05:58 AM
?Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Range
Dim v_message As String
If Selection.Count > 1 Then Exit Sub
If Target.Row > 2 Then
For Each cell In Range(Cells(Target.Offset(-1, 0).Row, 1), _
Cells(Target.Offset(-1, 0).Row, 50))
If cell.Value = "" Then
v_message = v_message & cell.Address & vbCrLf
End If
Next cell
MsgBox ("Fill in a value for : " & vbCrLf & v_message), vbInformation
Target.Offset(-1, 0).Select
End If
End Sub

Simon Lloyd
05-24-2007, 06:06 AM
Charlize, your code produces a message box regadless of whether a cell is blank in a row or not!, nor does it transport the user to the offending cell, i see where you're going with it though.

Bob Phillips
05-24-2007, 06:07 AM
Might be me Bob but the above appears to do nothing! Try moving to a new row before you complete the current row (BTW I set numcells to 5 not 50).

Charlize
05-24-2007, 06:11 AM
Charlize, your code produces a message box regadless of whether a cell is blank in a row or not!, nor does it transport the user to the offending cell, i see where you're going with it though.A messagebox with only the address values of the empty cells of the previous row. Fill in some data at a row and move a row lower.

malik641
05-24-2007, 06:14 AM
Ok. Now I understand better what's going on. Nevermind my CountA comment.

Simon Lloyd
05-24-2007, 06:16 AM
Yep spotted the NumCells, however still apears to do nothing, i used a blank sheet strted entering data moving down a row after each cell entry and nothing? in your code (because of your pc problems) you have If mPrevRow 0 Then
If mPrevRow Target.Row Theni assumed it should be
If mPrevRow = 0 Then
If mPrevRow > Target.Row Then

malik641
05-24-2007, 06:18 AM
Using some of Charlize's code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row < 2 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If oldRng Is Nothing Then Set oldRng = Target.Offset(-1, 0)

Dim rng As Excel.Range
Dim sMsg As String

For Each rng In Range(Cells(oldRng.Row, 1), Cells(oldRng.Row, 50))
If rng.Value = "" Then sMsg = sMsg & rng.Address & vbCrLf
Next rng

If sMsg <> "" Then
MsgBox ("Please fill a value for: " & vbCrLf & sMsg), vbInformation

Application.EnableEvents = False
oldRng.Select
Application.EnableEvents = True
Exit Sub
End If

Set oldRng = Target
End Sub

malik641
05-24-2007, 06:22 AM
Small correction:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row < 2 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If oldRng Is Nothing Then Set oldRng = Target.Offset(-1, 0)

Dim rng As Excel.Range
Dim sMsg As String

For Each rng In Range(Cells(oldRng.Row, 1), Cells(oldRng.Row, 50))
If rng.Value = "" Then sMsg = sMsg & rng.Address & vbCrLf
Next rng

If sMsg <> "" And (oldRng.Row <> Target.Row) Then
MsgBox ("Please fill a value for: " & vbCrLf & sMsg), vbInformation

Application.EnableEvents = False
oldRng.Select
Application.EnableEvents = True
Exit Sub
End If

Set oldRng = Target
End Sub

Simon Lloyd
05-24-2007, 06:37 AM
Malik641, if you try your adaptation you will find that if you have a row of data, lets say in row 1, enter data in A2 hit enter and yes you do get the msgbox, ok the msgbox and make an entry in B2 but rather than hit enter click any cell in row 1....no msgbox, you were allowed to leave the row without completing all 50 cells and no warning!

malik641
05-24-2007, 06:41 AM
Good catch Simon. How about this?
EDIT:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Row < 2 Then
Set oldRng = Target
Exit Sub
End If
If oldRng Is Nothing Then Set oldRng = Target.Offset(-1, 0)

Dim rng As Excel.Range
Dim sMsg As String

For Each rng In Range(Cells(oldRng.Row, 1), Cells(oldRng.Row, 50))
If rng.Value = "" Then sMsg = sMsg & rng.Address & vbCrLf
Next rng

If sMsg <> "" And (oldRng.Row <> Target.Row) Then
MsgBox ("Please fill a value for: " & vbCrLf & sMsg), vbInformation

Application.EnableEvents = False
oldRng.Select
Application.EnableEvents = True
Exit Sub
End If

Set oldRng = Target
End Sub

johnske
05-24-2007, 06:44 AM
Looping is so slow, try

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
If Target.Row = 1 Then Exit Sub
If Selection.Cells.Count > 1 Then Exit Sub
'
Application.EnableEvents = False
'
'used to set the used range from A to AX
'because special cells uses the used range
With Me.Range("A1", "AX1")
.Value = .Value
End With
'
On Error GoTo Finish
If Not Target.Row - 1 = 1 Then
With Me.Range("A" & Target.Row - 1, "AX" & Target.Row - 1).SpecialCells(xlCellTypeBlanks)
MsgBox "The ranges " & .Address(0, 0) & " are still blank"
.Select
End With
End If
Finish:
Application.EnableEvents = True
End Sub

Simon Lloyd
05-24-2007, 06:49 AM
Just the same!, you cannot select an empty row, you get the msgbox and back to OldRng but select a completed row and nothing (the completed row was above the target row)

Right gotta do schoool run back in around 2hrs!

malik641
05-24-2007, 06:59 AM
Just the same!, you cannot select an empty row, you get the msgbox and back to OldRng but select a completed row and nothing (the completed row was above the target row)

Right gotta do schoool run back in around 2hrs!
If you have the entire row filled it will let you move down to a new row. I thought that's what the idea was? Have the user fill 50 columns until moving to the next row.

I adjusted it to be able to move back to previous rows that are filled in:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Row < 2 Then
Set oldRng = Target
Exit Sub
End If
If Application.WorksheetFunction.CountA(Range(Cells(Target.Row, 1), _
Cells(Target.Row, 50))) >= 50 Then Set oldRng = Target: Exit Sub

If oldRng Is Nothing Then Set oldRng = Target.Offset(-1, 0)

Dim rng As Excel.Range
Dim sMsg As String

For Each rng In Range(Cells(oldRng.Row, 1), Cells(oldRng.Row, 50))
If rng.Value = "" Then sMsg = sMsg & rng.Address & vbCrLf
Next rng

If sMsg <> "" And (oldRng.Row <> Target.Row) Then
MsgBox ("Please fill a value for: " & vbCrLf & sMsg), vbInformation

Application.EnableEvents = False
oldRng.Select
Application.EnableEvents = True
Exit Sub
End If

Set oldRng = Target
End Sub

Bob Phillips
05-24-2007, 07:45 AM
Yep spotted the NumCells, however still apears to do nothing, i used a blank sheet strted entering data moving down a row after each cell entry and nothing? in your code (because of your pc problems) you have If mPrevRow 0 Then
If mPrevRow Target.Row Theni assumed it should be
If mPrevRow = 0 Then
If mPrevRow > Target.Row Then No that should be



If mPrevRow <> 0 Then
If mPrevRow <> Target.Row Then

Simon Lloyd
05-24-2007, 09:41 AM
Just tried Bob's code...start to fill a row move away get the msgbox, ove to a filled row still get msgbox...works well Bob.....will try the rest shortly after doing the college run!
Lol

Great thread and solutions guys!

Simon Lloyd
05-24-2007, 09:45 AM
Just one more, Johnske just tried yours...very nice the way it works, however unlike Bob's you only get the msgbox when you move from the unfinished row once, Bob's will appear every time if the row is not completed....still nice that the remaining or offending cells are selected.

Edit: I thought i didnt do too bad a job at it until you lot proved my ineptitude!, i love learning!

Bob Phillips
05-24-2007, 10:04 AM
And we love showing you (your ineptitude that is :yes)

malik641
05-24-2007, 10:16 AM
Makes us feel superior :)

Simon Lloyd
05-24-2007, 10:27 AM
Awe guys!, with friends like you i can stop the girlfriend abusing me! Thanks!

Simon Lloyd
05-24-2007, 10:33 AM
Malik641, just tried your code, and you are still able to select a completed row leaving the one you are on incomplete without msgbox i started to fill row 5, typed in a cell didn't press enter just clicked in row 3 which is completed no msgbox and the move was allowed.

malik641
05-24-2007, 11:00 AM
Ok. Then I think you want this:
Option Explicit
Private oldRng As Excel.Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
' If Target.Row < 2 Then
' Set oldRng = Target
' Exit Sub
' End If
' If Application.WorksheetFunction.CountA(Range(Cells(Target.Row, 1), _
' Cells(Target.Row, 50))) >= 50 Then Set oldRng = Target: Exit Sub

If oldRng Is Nothing Then Set oldRng = Range("A1")

Dim rng As Excel.Range
Dim sMsg As String

For Each rng In Range(Cells(oldRng.Row, 1), Cells(oldRng.Row, 50))
If rng.Value = "" Then sMsg = sMsg & rng.Address & vbCrLf
Next rng

If sMsg <> "" And (oldRng.Row <> Target.Row) Then
MsgBox ("Please fill a value for: " & vbCrLf & sMsg), vbInformation

Application.EnableEvents = False
oldRng.Select
Application.EnableEvents = True
Exit Sub
End If

Set oldRng = Target
End Sub

malik641
05-24-2007, 11:02 AM
By the way, this sounds like a job for Access...but then again I'm not completely sure what you're doing :)

Simon Lloyd
05-24-2007, 11:21 AM
Malik641, it isn't for me
Hi all i have answered a post where the Op's asked if cells 1 - 50 in a row could be checked to make sure they are not blank before moving rows, heres the solution:
i provided a solution as per the start of thread but asked here what did folk think can it be done better - evidently it can be done a lot better!

Your last posting does what was required except one thing - selecting the blank cell...but i'm looking a that as we speak.

johnske
05-24-2007, 01:44 PM
Just one more, Johnske just tried yours...very nice the way it works, however unlike Bob's you only get the msgbox when you move from the unfinished row once, Bob's will appear every time if the row is not completed....still nice that the remaining or offending cells are selected.

Edit: I thought i didnt do too bad a job at it until you lot proved my ineptitude!, i love learning!I thought having to kill the msgbox for every cell was too time-consuming (and annoying) so the way mine works is that all empty cells on the row are selected and the first one is the active cell - as you fill in the data the next empty cell in the row becomes the active cell when you hit enter...etc. But you'll get the message again if you try to skip any any and go to the next row :)