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

 

[learjsy]

Works perfectly now with the year sheets, but doesn't seem to do anything on the 'Funding (Credits)' sheet while on the 'Disbursements & S.Fees (Debits)' sheet I get back the following Microsoft VB error: 'Run-time error '1004': Application-defined or object-defined error'.

 

[wideboydixon]

OK. Apologies for yet another error. I've found the problem and fixed it. I'm not having a good day obviously. On the year sheets, I see that the dates are already filled so it will work as intended. On the other two sheets, it will only work if you fill in the date in column B before filling in any other information. I didn't realise that you need to enter the date on those sheets first so I'll make allowances for that. Have a stab with this:

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(Sh.Name) Then
    Set changedRange = Sh.Range("D:Q")
ElseIf Sh.Name = "Disbursements & S.Fees (Debits)" Then
    Set changedRange = Sh.Range("B:J,L:L")
ElseIf Sh.Name = "Funding (Credits)" Then
    Set changedRange = Sh.Range("B: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 = Replace(changedCell.AddressLocal, "$", "")
            Else
                Set clearRange = Application.Union(changedCell, clearRange)
                errorCells = errorCells & ", " & Replace(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

 

[learjsy]

OK. Apologies for yet another error. I've found the problem and fixed it. I'm not having a good day obviously. On the year sheets, I see that the dates are already filled so it will work as intended. On the other two sheets, it will only work if you fill in the date in column B before filling in any other information. I didn't realise that you need to enter the date on those sheets first so I'll make allowances for that. Have a stab with this:

WBD[/QUOTE]


Looks like that's fixed it and it's working as desired. Thanks a lot WBD!