Hi marie_kula,
Private Sub Worksheet_SelectionChange(
src = Array([A4], [C4]) 'Add as many cells as needed
dst = Array([A1], [A4]) 'List of cells which are to be filled
For i = LBound(src) To UBound(src)
If (Not Intersect(Target, src(i)) Is Nothing) Then
If (dst(i) = "") Then
MsgBox "First fill cell " & dst(i).Address(False, False)
dst(i).Select
End If
End If
Next
End Sub
---
Harish
Main Topics
Browse All Topics





by: kenpulsPosted on 2006-01-15 at 00:18:31ID: 15703823
Hi there,
One way follows here. This is a Worksheet_Change event, which means that it must go in the Sheet module for the worksheet you want it to run on. To get there easily, in Excel, right click the sheet tab, click View Code and paste this in the resulting pane:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lFilled As Long
'Prevent recursive calls
Application.EnableEvents = False
'One of these for each range you want to check
If Target.Parent.Range("A1") <> "" Then lFilled = lFilled + 1
If Target.Parent.Range("A4") <> "" Then lFilled = lFilled + 1
'Check the target cell
Select Case Target.Address
Case Is = "$A$4"
If lFilled < 1 Then
MsgBox "You have not entered data in cell A1!"
Target.ClearContents
End If
Case Is = "$C$4"
If lFilled < 2 Then
MsgBox "You have not entered data in cell A4!"
Target.ClearContents
End If
End Select
'Resume events
Application.EnableEvents = True
End Sub
In order to keep updating this, you'd need to:
-add each cell that requires completion to the If Target.Parent section (copy the whole line and change the cell reference) in order
-add a new case for the cell the data is being placed in. Copy the most recent Case Is though End If lines and place them before the End Select line. Update the address, increase the lFilled < line by 1, and update the messagebox code.
HTH,