Solved: Controlling Data Entry

[ROK]

I have an excel doc and I'm trying to control data entry and make fields required under certain conditions. So, if you select any part of the range A5:I5 (A4:I4 is a list of headings) you must complete all fields before being able to close the doc. but if you start the next row range A6:I6 again you must complete fully and any other row you begin until you have all updates complete. Any help would be greatly appreciated.

[AnAnalyst]

Hi ROK,

If I've understood your post correctly then this should do something like what you need:

Paste the following code into the ThisWorkbook module:

' Check field population before sheet closes
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Run the cell population check
CellsCompletedCheck
' If the check fails then display message and do not close
If booFieldsComplete = False Then
Cancel = True
strResponse = MsgBox( _
"Not all required fields were completed", _
vbExclamation, _
"Incomplete Data")
End If
End Sub

Insert a new vba module and paste in the following code:

Option Base 1
' For checking if all fields are complete
Public booFieldsComplete As Boolean
' Set the number of columns to test
Const intColumns As Integer = 9
' Set the row number in which are headings
Const intHeadRow As Integer = 4
' Variable to calculate last used row
Dim lngLastRow As Long
' Variable to hold the sheet where the data is kept
Dim shtDataSheet As Worksheet
' Array (Option base 1) for calculations
Dim arrCounts(intColumns) As Integer
' Counter variable for loops
Dim intCounter As Integer
' Variable to hold count of count cells in range
Dim lngCellsInRange As Long
' Variable to hold count of populated cells
Dim lngCompletedCells As Long
Sub CellsCompletedCheck()
' Set the worksheet to examine (change text in quotes to the name of your sheet)
Set shtDataSheet = ThisWorkbook.Sheets("Sheet1")
' Find the last used row in each column
For intCounter = 1 To intColumns
With shtDataSheet
arrCounts(intCounter) = .Cells(.Rows.Count, intCounter).End(xlUp).Row
End With
Next intCounter
' Set the last row variable
lngLastRow = WorksheetFunction.Max(arrCounts)
' If the last row is the header then quit
If lngLastRow < intHeadRow + 1 Then
booFieldsComplete = True
Exit Sub
End If
' Do calculations for the check
With shtDataSheet
lngCellsInRange = intColumns * (lngLastRow - intHeadRow)
lngCompletedCells = WorksheetFunction.CountA(.Cells(5, 1).Resize(lngLastRow - intHeadRow, intColumns))
End With
' Perform the logical check to see if all used fields are populated
booFieldsComplete = lngCellsInRange = lngCompletedCells
' Reset the worksheet variable
Set shtDataSheet = Nothing
End Sub

Hope this assists,

Regards,

AnAnalyst

[mikerickson]

If you put this in the ThisWorkbook code module, closing a workbook will prompt the user to enter any missing data from A:I row 5 downward.

The user can choose to close without entering the missing data.

When prevented from closing, users can get forceful and start unplugging things, so a clear warning is preferred to absolutely preventing the close.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim dataRange As Range, emptyRange As Range
Dim strPrompt As String
Dim oneCell As Range
Dim uiValue As Variant

With ThisWorkbook.Sheets("Sheet1")
Set dataRange = .Range("A5")
For Each oneCell In .Range("A4:I4")
Set dataRange = Range(dataRange, oneCell.EntireColumn.Cells(Rows.Count, 1).End(xlUp))
Next oneCell

On Error Resume Next
Set emptyRange = dataRange.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If Not emptyRange Is Nothing Then

For Each oneCell In emptyRange
strPrompt = "Enter the data for " & oneCell.Address
Do
uiValue = Application.InputBox(strPrompt, Type:=7)
If TypeName(uiValue) = "Boolean" And uiValue = False Then Exit For
oneCell.Value = uiValue
Loop Until uiValue <> vbNullString
Next oneCell

If TypeName(uiValue) = "Boolean" And uiValue = False Then
strPrompt = "There is missing data." & vbCr & vbCr & "Continue with close?"
Cancel = MsgBox(strPrompt, vbYesNo + vbDefaultButton2) = vbNo
End If

End If
End With
End Sub