Simple VBA script to prevent data input based on certain criteria

[learjsy]

I am building a workbook for my wife which will be used for tracking the time she spends on her projects, amongst other things. The data is organised by years (i.e. each sheet is e.g. '2018', '2017' etc), and then in each sheet, cells B4:B369 contain the dates from 1/1/20XX - 31/12/20XX, with corresponding information relating to each date in the associated columns D-Q.

Columns D-K are fields for inputting times (start/stop windows if you like, to record hours spent on a project in a given day), while the other columns track other variables.

On a master input sheet ('Rates & Classifications') I have a global Project Start Date in cell B2.

I would like to have an error message appear if any of the associated cells (column D-Q) are completed with any information when their corresponding date (in column B) precedes the Project Start Date.

I had tried to do this using Data Validation but there are two issues with this:

1. I wish to restrict the inputs in columns D-Q in ways other than using a validation criteria - custom formula (eg. columns J-Q are drop-down menus, picking up dynamic lists from the 'Rates & Classifications' sheet)
2. While I found a formula that could throw back an error if any of the columns D-Q contained data when the corresponding date cell (in column B) precedes the Project Start Date (namely, IF(AND(NOT(SUMPRODUCT(--(D4:Q4<>""))=0),B4<'Rates & Classifications'!$B$2),"Error","")), I have read online that Data Validation Error messages are designed to work based on a user's input, not based on the output of a formula used with the custom validation criteria selection.

From some quick 'google-research' I have however seen suggestions that this could be achieved quite easily with VBA?!

Any suggestions therefore for a simple VBA script (and how to implement it for someone with zero VBA knowledge) would be very gratefully appreciated!

Many thanks in advance

 

[wideboydixon]

Hi and welcome to the forum. I think I understand your requirements and I've created some code that should help. Right click the tab name and select "View Code" to bring up the VBA editor and then double click the "ThisWorkbook" node under VBAProject\Microsoft Excel Objects. Paste the following:

Private Const RC_SHEET_NAME = "Rates & Classifications"
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim changedRange As Range
Dim projectStartDate As Date
Dim changedCell As Range
Dim errorCells As String

' Don't take action on the R&C sheet
If Sh.Name = RC_SHEET_NAME Then Exit Sub

' Check if anything in columns D:Q have been changed
Set changedRange = Application.Intersect(Target, Sh.Range("D:Q"))
If changedRange Is Nothing Then Exit Sub

' Get the project start date
projectStartDate = Sheets(RC_SHEET_NAME).Range("B2").Value

' Check all rows where data has been changed
For Each changedCell In changedRange
    If Not IsEmpty(changedCell.Value) Then
        If Sh.Cells(changedCell.Row, "B").Value < projectStartDate Then
            errorCells = errorCells & changedCell.AddressLocal & ", "
        End If
    End If
Next changedCell

' Errors?
If Len(errorCells) > 0 Then
    MsgBox "Data entered in " & Left$(errorCells, Len(errorCells) - 2) & " precedes the project start date", vbCritical + vbOKOnly
End If

End Sub

This code will check data entered into columns D:Q in the sheet and check the value in column B against the project start date from B2 on the "Rates & Classifications" sheet. Hope that's what you're after.

WBD

 

[learjsy]

Sincere thanks for that WBD but, having followed your steps, it doesn't seem to have done anything. Anything I might be doing wrong - or perhaps my original brief wasn't clear enough?

 

[wideboydixon]

Hmmm. I tested locally and it was working OK. Here's what it does:

When data is changed in columns D:Q in a sheet other than "Rates & Classifications" then it will:
- Retrieve the project start date from cell B2 on the "Rates & Classifications" sheet
- For each cell that has changed, check the value in column B on the current sheet
- If the value in column B is less than the project start date, it will generate an error

Did you definitely paste into the "ThisWorkbook" module?

WBD

 

[learjsy]

Yes, definitely pasted into the correct module. (Although I note two 'VBAProjects' - one with the name of my workbook (which I assume is the right one, and where I have pasted the code within the ThisWorkbook module), and another which I have ignored called 'FUNCRES.XLAM', which also has a ThisWorkbook module...

Could it be to do with the fact that my workbook contains sheets other than those labelled with years - I have these to pull across data and consolidate information for the project, as well as track other information. These sheets don't therefore have a column B with dates listed (as the '2018' etc sheets do)??

In other words, the sheets labelled by years for which I need the vba code are a subset of all the sheets.

Finally, could the error message provide a helpful prompt to action with a simple message such as: 'Data inputted is in respect of a date which precedes the Project Start Date. Please review and re-enter against a permitted date.'

Thanks

 

[wideboydixon]

What's the pattern for the sheets where the code should run? Do the names start with "2018"?

WBD

 

[learjsy]

What's the pattern for the sheets where the code should run? Do the names start with "2018"?

WBD

Hi WBD

I think we're closer than I thought last night - I rebooted my computer this morning and the macro seems to work now! Not quite sure what happened yesterday as I had saved the workbook with it and then re-opened.

Anyhow, is it possible to have two slight modifications which will then I think give me an optimum result:

1. In broad terms, there are three groups of sheets:

(i) The first are the year ones ("2018", "2019", etc) where the macro now works as intended.
(ii) A second set (of two sheets called "Disbursements & S.Fees (Debits)" and "Funding (Credits)") where data is also organised against dates listed down column B, but where the corresponding input columns are C-J (inclusive) & L for the Disbursement sheet, while they are columns C-G (inclusive) for the Funding sheet. Could you replicate the macro to work in exactly the same manner for these sheets (i.e. error message if any input in one of the corresponding cells where the associated BX cell contains a date that proceeds the Project Start Date) but for the different corresponding columns?
(iii) The third set of sheets are summary sheets and I would like the macro not to apply to these at all.

I presume the impact of the macro on different sheets can be achieved by pasting it to the specific sheet modules, rather than the 'Thisworkbook' one?

2. Would it be possible for the macro to clear the cell that has been incorrectly completed when you click 'ok' on the error message? At present clicking 'ok' just dismisses the error message, but the input data which gave result to the message remains.

Many thanks - and promise that's the extent of the issues!

 

[wideboydixon]

Yes it's possible to attach the macro to the Sheet_Change() event on each sheet but it's a pain to maintain multiple copies of the same macro. Give this a try:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim changedRange As Range
Dim projectStartDate As Date
Dim changedCell As Range
Dim errorCells As String
Dim clearRange As Range

' Decide on range to deal with
If IsNumeric(Left(Sh.Name, 4)) Then
    Set changedRange = Sh.Range("D:Q")
ElseIf Left(Sh.Name, "13") = "Disbursements" Then
    Set changedRange = Sh.Range("C:J,L")
ElseIf Left(Sh.Name, 7) = "Funding" Then
    Set changedRange = Sh.Range("C:G")
End If

' Quit now if we're ignoring this sheet
If changedRange Is Nothing Then Exit Sub

' Check if anything in the check range has been changed
Set changedRange = Application.Intersect(Target, changedRange)
If changedRange Is Nothing Then Exit Sub

' Get the project start date
projectStartDate = Sheets("Rates & Classifications").Range("B2").Value

' Check all rows where data has been changed
For Each changedCell In changedRange
    If Not IsEmpty(changedCell.Value) Then
        If errorCells = "" Then
            Set clearRange = changedCell
            errorCells = changedCell.AddressLocal
        Else
            Set clearRange = Application.Union(changedCell, clearRange)
            errorCells = errorCells & ", " & changedCell.AddressLocal
        End If
    End If
Next changedCell

' Errors?
If Len(errorCells) > 0 Then
    MsgBox "Data entered in " & errorCells & " precedes the project start date", vbCritical + vbOKOnly
    clearRange.ClearContents
End If

End Sub

WBD

 

[learjsy]

Good morning WBD

I applied the macro but unfortunately it is not working as planned. The input data is being scrubbed when the error message appears (tick), and the macro doesn't give rise to error messages on the third group of sheets (tick), but unfortunately the date check doesn't seem to work at all on the first two sets of sheets - I get the pop up message whether or not data is inputted before or after the project start date.

Reflecting though, I think there could be an easy and effective work-around to all of this. I still have a formula in column A of my year sheets, as follows: IF(AND(NOT(SUMPRODUCT(--(D4:Q4<>""))=0),B4<'Rates & Classifications'!$B$2),"Date Error",""). And there's an equivalent in the Disbursements and Funding sheets to deal with their associated input columns.

Perhaps the easiest way to achieve the desired result is to amend the macro to produce the error message if the relevant cell in column A produces a "Date Error" result? The additional benefit is that the macro could be applied to the entire workbook without any modification since only the first two sets of sheets have this column A formula and the formula itself deals with the different column arrays between the different sheets?

Hope that's clear enough, and sorry that this has taken longer than originally envisaged. Your efforts greatly appreciated

 

[wideboydixon]

Sorry; my mistake. I didn't test the macro and I clearly removed the checking of the date. Doh.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim changedRange As Range
Dim projectStartDate As Date
Dim changedCell As Range
Dim errorCells As String
Dim clearRange As Range

' Decide on range to deal with
If IsNumeric(Left(Sh.Name, 4)) Then
    Set changedRange = Sh.Range("D:Q")
ElseIf Left(Sh.Name, "13") = "Disbursements" Then
    Set changedRange = Sh.Range("C:J,L")
ElseIf Left(Sh.Name, 7) = "Funding" Then
    Set changedRange = Sh.Range("C:G")
End If

' Quit now if we're ignoring this sheet
If changedRange Is Nothing Then Exit Sub

' Check if anything in the check range has been changed
Set changedRange = Application.Intersect(Target, changedRange)
If changedRange Is Nothing Then Exit Sub

' Get the project start date
projectStartDate = Sheets("Rates & Classifications").Range("B2").Value

' Check all rows where data has been changed
For Each changedCell In changedRange
    If Not IsEmpty(changedCell.Value) Then
        If Sh.Cells(changedCell.Row, "B").Value < projectStartDate Then
            If errorCells = "" Then
                Set clearRange = changedCell
                errorCells = changedCell.AddressLocal
            Else
                Set clearRange = Application.Union(changedCell, clearRange)
                errorCells = errorCells & ", " & changedCell.AddressLocal
            End If
        End If
    End If
Next changedCell

' Errors?
If Len(errorCells) > 0 Then
    MsgBox "Data entered in " & errorCells & " precedes the project start date", vbCritical + vbOKOnly
    clearRange.ClearContents
End If

End Sub

WBD