Excel/vba solution to partial data entry into cell range
QUESTION: Hi Jan,
I have a workbook which has a worksheet called Data
Range a1:b20 are pre-populated.
Rows 1-4 are drop down selection boxes from column C onwards to the end of the
Users enter data in any column from C onwards using the drop down selections in rows
1-4 and manually inputting data into rows 5-20.
Is there a simple way with vba upon workbook close to detect which column or columns
have had values added in this sheet between rows 1 and 20 and flash up a message if
there are any empty cells between rows 1-20?
Ideally the missing cell values would be highlighted in red and the user would not
be able to save the workbook until all values had been entered.
E.g. Sometimes users may try and complete all 20 rows of column C and only part of D
and E (selecting date from drop down) etc. I would like users to complete all
columns between rows 1 and 20 where they have entered/selected a value and be
reminded that there are missing values that need entering, if this is the case, see
those highlighted in red and be unable to save until entering values.
I hope that is clear.
Apologies if repeating myself has muddled things!
Sample can be sent if needed.
ANSWER: Hi Quentin,
Is the number of columns they need to fill out always the same or is it just that no gaps are allowed?
---------- FOLLOW-UP ----------
The rows 1-20 should not have any gaps starting at column c.
The column numbers is variable. Ideally what happens is that column c, d, e are completed at 10am,1pm and 3pm on a particular day. The next day however the person completing may use column f,g and h or change the date in the drop down in row 1 of columns c,d and e and use these columns instead.
This is why I thought check which columns have values added from column c onwards then ensure no gaps between rows 1 and 20.
Hope that makes sense?
Put this code in a normal module:
Function TestData(oSh As Worksheet)
Dim oCurData As Range
Dim oBlanks As Range
Dim oCell As Range
Dim bFoundEmpty As Boolean
On Error Resume Next
For Each oCell In Intersect(oSh.UsedRange, oSh.Range("C:C")).Cells
Set oCurData = oSh.Range(oCell, oSh.Cells(oCell.Row, oSh.Columns.Count).End(xlToLeft))
Set oBlanks = Nothing
Set oBlanks = oCurData.SpecialCells(xlCellTypeBlanks)
If Not oBlanks Is Nothing Then
oBlanks.Interior.Color = vbRed
bFoundEmpty = True
If bFoundEmpty Then
MsgBox "Found empty cells, please fill the red cells first!", vbExclamation + vbOKOnly
TestData = False
TestData = True
And this code in the ThisWorkbook module:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If TestData(ThisWorkbook.Worksheets("Sheet1")) Then
'Not OK, cancel closing
Cancel = True
Note that it tests the data in a sheet called Sheet1.