How to validate the column using multiple column values in excel VBA [closed]-CodePudding

Closed. This question needs to be more

Below are the validation rules:

Date2 column validation: Date1<>"" and Date2>Date1
Value Column validation: If Value<>"" then Time1 and Time2 is Blank
Time1 column data validation: Value=""
Time2 column data validation: Value="" and Time1<>"" and Time2>Time1

Thanks, Mark

CodePudding user response：

Unsure why you want a vba solution (as you don't say). You also don't say what you want the 'vba' to do, should one of the rules be broken.

Here is an Excel formula solution using a 'checks' column to the right of the table.
It's based on the table headers being in row 1, with data 'check' cells starting at row 2

=IF(AND(A2<>"",B2<>"",A2>=B2),"Err: Date1 not before Date2",IF(AND(C2<>"",OR(D2<>"",E2<>"")),"Err: Value or Times not both",IF(AND(D2<>"",E2<>"",D2>=E2),"Err: Time1 not Before Time2","-")))

You could use that as is, with the Error flagging simply being the display of one of the 'Err:' texts
Or, you could take it apart, and use the individual bits in conditional formats to (e.g.) change cell colors on error in the relevant cells.

If that's not a fit (and you need 'vba'): Could you explain what form of 'vba' and what you want it to do in the case of an error.

EDIT:
The code below provides similar behavior to data validation.
Its goes into the vba of the sheet where the data entry will occur

Option Explicit

Private Sub Worksheet_Change(ByVal rgChanged As Range)

    Const stMT$ = "Data Validation"
    Dim vnVal, stErr$

''' Ignore if Blank
    If rgChanged = "" Then Exit Sub

''' Confirm 1st cell of changed in the defined table data
''' o  assumes the table is in range A1:E9 with headers in row 1
''' o  Hence the 'data to be validated' is A2:E9
''' o  If your table is bigger or elsewhere: Change the address her accordingly
    If Intersect(rgChanged.Cells(1), Range("A2:E9")) Is Nothing Then Exit Sub
    
''' The code below makes the same assumption regard columns
''' o  If your table is elsewhere: Change the column numbers

With rgChanged.Cells(1): vnVal = .Value
    
    Select Case .Column
        Case 1  ' Absolute column number of Date1
            If Not IsDate(vnVal) Then
                stErr = "Date1 fields must be dates"
            ElseIf .Offset(0, 1) <> "" And vnVal > .Offset(0, 1) Then
                stErr = "Date1 field must be before Date2"
            End If
        
        Case 2  ' Absolute column number of Date2
            If Not IsDate(vnVal) Then
                stErr = "Date2 fields must be dates"
            ElseIf .Offset(0, -1) <> "" And vnVal <= .Offset(0, -1) Then
                stErr = "Date2 field must after Date1"
            End If
    
        Case 3  ' Absolute column number of Value
            If vnVal Like "*[!.0-9]*" Then
                stErr = "Value fields must numbers only"
            ElseIf .Offset(0, 1) <> "" Or .Offset(0, 2) <> "" Then
                stErr = "Enter a Value or Times (not both)"
            End If
    
        Case 4  ' Absolute column number of Time1
            If Val(vnVal) = 0 Or vnVal >= 1 Then
                stErr = "Time fields must times only"
            ElseIf .Offset(0, -1) <> "" Then
                stErr = "Enter a Value or Times (not both)"
            ElseIf .Offset(0, 1) <> "" And vnVal >= .Offset(0, 1) Then
                stErr = "Time1 field must be before Time2"
            End If
    
        Case 5  ' Absolute column number of Time2
            If Val(vnVal) = 0 Or vnVal >= 1 Then
                stErr = "Time fields must times only"
            ElseIf .Offset(0, -2) <> "" Then
                stErr = "Enter a Value or Times (not both)"
            ElseIf .Offset(0, -1) <> "" And vnVal <= .Offset(0, -1) Then
                stErr = "Time2 field must after Time1"
            End If
    End Select

End With

''' If errored: Report to user and undo the change
    If stErr <> "" Then
        MsgBox Buttons:=64, Title:=stMT, Prompt:=stErr
        With Application
            .EnableEvents = False: .Undo: .EnableEvents = True
        End With
    End If

End Sub

Page link：https//www.codepudding.com/Blockchain/138861.html

Prev:Count rows without duplicate (with 1 condition)?

Next:Add percentage numbers from a cell in PPTX

Tags：

excel

vba

Links：
CodePudding