PDA

View Full Version : Solved: Multiple force entry



yorkie
09-24-2011, 03:04 AM
I've searched the web and still can't find anything that could shed some light on this.:banghead: Can any one advise.
I currently have a macro-enabled workbook that when the user puts an entry into column L they must also put an entry in column M and N.
the range for entry is L5:L35 with the corresponding range for M and N being the same number of rows.
What i need to do is
When an entry is put in L5 the user HAS to put a valid entry in M5 AND N5.
Currently the values for the ranges are
L column - any number from 0.5 to 24
M column - a drop down list is used to select names
N column - a drop down list that has three options, i.e Left, Right, Unknown.
E.G It needs to be so that once they enter something in L5 they HAVE to enter something in M5 AND N5 or they can't move to another cell.
Im i making sense? ANy help would be greatly appreciated.
Thank you.

Kenneth Hobs
09-26-2011, 07:02 AM
Welcome to the forum!

Right click the sheet tab, View Code, and paste:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iRange As Range, tRow As Long, tCol As Integer
Set iRange = Intersect(Target, Range("L5:L35,M5:N35"))
If iRange Is Nothing Then Exit Sub
tRow = Target.Row
tCol = Target.Column
Select Case True
Case tCol = 12 Or tCol = 13 Or tCol = 14 And IsEmpty(Range("M" & tRow))
Range("M" & Target.Row).Select
rRow = tRow
Case tCol = 12 Or tCol = 13 Or tCol = 14 And IsEmpty(Range("N" & tRow))
Range("N" & tRow).Select
rRow = tRow
Case Not IsEmpty("L" & tRow) And Not IsEmpty("M" & tRow) And Not IsEmpty("N" & tRow)
rRow = 0
End Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
SetFocusToMissingData
End Sub
In the VBE, View > Project Explorer > double click ThisWorkbook and paste:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If rRow > 0 Then
SetFocusToMissingData
Cancel = True
End If
End Sub

Private Sub Workbook_Open()
rRow = 0
End Sub


In VBE, Insert > Module and paste:
Public rRow As Long

Sub SetFocusToMissingData()
If rRow = 0 Then Exit Sub
Select Case True
Case Not IsEmpty(Range("L" & rRow)) And IsEmpty(Range("M" & rRow))
Range("M" & rRow).Select
Case Not IsEmpty(Range("L" & rRow)) And IsEmpty(Range("N" & rRow))
Range("N" & rRow).Select
End Select
End Sub

yorkie
10-08-2011, 04:06 AM
Thanks Kenneth,

That was 100% perfect! It's a bit being like a dictator but you can only ask people so many times to do something!
Many thanks your a life saver.

Paul