Making cells mandatory to fill in

[Jock]

I need to ensure that certain cells in every row are filled in by the user.
How can I add code to force data input into, say, columns D, E and H when
the user navigates to the next row? Perhaps a popup box informing the user
and highlight the empty cell(s) in yellow for instance? Can the user then not
be able to continue until the empty cell(s) are filled in?

Thanks,

 

[Gary''s Student]

Put this event macro in the worksheet code area:

Dim oldrow As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If oldrow = 0 Then
oldrow = Target.Row
Exit Sub
End If
newrow = Target.Row
If newrow <= oldrow Then Exit Sub
If IsEmpty(Cells(oldrow, "D")) Or IsEmpty(Cells(oldrow, "H")) Or
IsEmpty(Cells(oldrow, "E")) Then
MsgBox ("must fill in D, E, and H of the previous row")
Application.EnableEvents = False
Cells(oldrow, "D").Select
Application.EnableEvents = True
Else
oldrow = newrow
End If
End Sub


Because it is worksheet code, it is very easy to install and use:

1. right-click the tab name near the bottom of the window
2. select View Code - this brings up a VBE window
3. paste the stuff in and close the VBE window

If you save the workbook, the macro will be saved with it.

To remove the macro:

1. bring up the VBE windows as above
2. clear the code out
3. close the VBE window

To learn more about macros in general, see:

http://www.mvps.org/dmcritchie/excel/getstarted.htm

To learn more about Event Macros (worksheet code), see:

http://www.mvps.org/dmcritchie/excel/event.htm

 

[Bernie Deitrick]

Jock,

Copy the code below, right-click the sheet tab, select "View Code" and paste in the window that
appears.

HTH,
Bernie
MS Excel MVP

Dim ForceChange As Boolean
Dim myRow As Long


Private Sub Worksheet_Change(ByVal Target As Range)
Dim myR As Range

If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Range("D:E,H:H"), Target) Is Nothing Then Exit Sub
Set myR = Intersect(Range("D:E,H:H"), Target.EntireRow)
If WorksheetFunction.CountBlank(myR.Areas(1)) + _
WorksheetFunction.CountBlank(myR.Areas(2)) > 0 Then
myRow = Target.Row
ForceChange = True
Else
ForceChange = False
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not ForceChange Or Target.Row = myRow Then Exit Sub
Application.EnableEvents = False
Intersect(Range("D:E,H:H"), Cells(myRow, 1).EntireRow) _
.SpecialCells(xlCellTypeBlanks)(1).Select
MsgBox "Please enter a value in cell " & Selection.Address
Application.EnableEvents = True
End Sub

 

[sgl]

Jock try this,

In a hidden column place the following formula:
=if(COUNTA($D1:$H1)=0,FALSE,COUNTA($D1:$H1)<>3)

Copy formula down to all cells required. Amend conditons as required for the
TRUE/FALSE option.

Use Conditional Formating across columns to refer to hidden column to turn
cell colour to RED if all cells you want completed are not completed. Use the
TRUE/FALSE return to change cell colour. Once user completes all three
required cells, cell colour returns to normal.

Hope this is easy way out/sgl

 

[Jock]

Hi Gary,
Unfortunately, I can't get this to work. Could this be because the "Dim old
row as long" appears outside the sub - I get an error message stating that
only comments may appear outside.


Cheers

 

[Jock]

Hi Bernie,
The "Dim ForceChange As Boolean
Dim myRow As Long" part is outside the sub and gives an error message.
I already have a 'worksheet change' event on the sheet so I added your code
to it, but it didn't do anything.
The sheet is password protected - could that be the problem?

Thanks,

--
Traa Dy Liooar

Jock

Jock,

Copy the code below, right-click the sheet tab, select "View Code" and paste in the window that
appears.

HTH,
Bernie
MS Excel MVP

Dim ForceChange As Boolean
Dim myRow As Long


Private Sub Worksheet_Change(ByVal Target As Range)
Dim myR As Range

If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Range("D:E,H:H"), Target) Is Nothing Then Exit Sub
Set myR = Intersect(Range("D:E,H:H"), Target.EntireRow)
If WorksheetFunction.CountBlank(myR.Areas(1)) + _
WorksheetFunction.CountBlank(myR.Areas(2)) > 0 Then
myRow = Target.Row
ForceChange = True
Else
ForceChange = False
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not ForceChange Or Target.Row = myRow Then Exit Sub
Application.EnableEvents = False
Intersect(Range("D:E,H:H"), Cells(myRow, 1).EntireRow) _
.SpecialCells(xlCellTypeBlanks)(1).Select
MsgBox "Please enter a value in cell " & Selection.Address
Application.EnableEvents = True
End Sub

 

[Bernie Deitrick]

Yes, but you can add code to unprotect, and then reprotect, the sheet. Change "password" in the two
instances to the actual password.

And having the dim statements at the top is OK, and is actually required in this case - but you
should have nothing else except this code:


Dim ForceChange As Boolean
Dim myRow As Long

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myR As Range

If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Range("D:E,H:H"), Target) Is Nothing Then Exit Sub
Set myR = Intersect(Range("D:E,H:H"), Target.EntireRow)
If WorksheetFunction.CountBlank(myR.Areas(1)) + _
WorksheetFunction.CountBlank(myR.Areas(2)) > 0 Then
myRow = Target.Row
ForceChange = True
Else
ForceChange = False
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not ForceChange Or Target.Row = myRow Then Exit Sub
Application.EnableEvents = False
Target.Parent.Unprotect "password"
Intersect(Range("D:E,H:H"), Cells(myRow, 1).EntireRow) _
.SpecialCells(xlCellTypeBlanks)(1).Select
MsgBox "Please enter a value in cell " & Selection.Address
Target.Parent.Protect "password"
Application.EnableEvents = True
End Sub


--
HTH,
Bernie
MS Excel MVP

Hi Bernie,
The "Dim ForceChange As Boolean
Dim myRow As Long" part is outside the sub and gives an error message.
I already have a 'worksheet change' event on the sheet so I added your code
to it, but it didn't do anything.
The sheet is password protected - could that be the problem?

Thanks,