Search code examples
excelvbavalidationonchangetarget

VBA Data Validation Error with Worksheet Change Code


I have been enhancing an input table where a user will be making various selections via drop-downs in certain columns and manually inputting values in others. The error(s) in question are occurring in the manual input cells (Columns G to nth column).

For additional context, I implemented various worksheet change coding and this included data validation via VBA.


ISSUE

The worksheet change code associated with this table was working before with no issue, but as I add more code, I am now dealing with an issue of a VBA-inputted data validation formula showing up after any kind of manual input, causing a DV error msg to populate if/when attempting to manually change the cells again.

1) Empty cell/empty DV (as expected) 2) Filled cell/filled DV formula 3) DV error when trying to change cell value 4) DV formula maintained even after cell made blank

It's a bit bulky and repetitive so I'm sharing a snippet so you can get the idea of how it would look with the other columns (targets) as well.


CURRENT CODE (NOT WORKING)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngB As Range
    Dim rngG As Range
    Dim rngH As Range
    Dim rngI As Range
    Dim rngJ As Range
    Dim myCell As Range
    
    Set rngB = Range("B7:B35")
    Set rngD = Range("D7:D35")
    Set rngG = Range("G7:G35")
    Set rngH = Range("H7:H35")
    Set rngI = Range("I7:I35")
    Set rngJ = Range("J7:J35")
    
    rngG.NumberFormat = "$#,##0.00"  
    rngH.NumberFormat = "0.00%"      
    rngI.NumberFormat = "$#,##0.00"  
    rngJ.NumberFormat = "$#,##0.00"  
    
    On Error GoTo ErrHandler 
       
    '---------------------------------------------------------------
    'Col B change event: null row if Col B empty/changed
    
    If Not Intersect(Target, rngB) Is Nothing Then
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        With Target
            'clear drop-downs
            Range(.Offset(0, 2), .Offset(0, 4)).ClearContents
            'clear # inputs
            Range(.Offset(0, 5), .Offset(0, 8)).ClearContents
              
            If .Value = "" Then
                Range(.Offset(0, 2), .Offset(0, 4)).ClearContents
                Range(.Offset(0, 5), .Offset(0, 8)).ClearContents
            End If
        End With
        
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        
    End If
    
    '---------------------------------------------------------------
    'Col G as target: change events related to Col G changes
    
    If Not Intersect(Target, rngG) Is Nothing Then
            
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        
        Select Case Target.Address
            
             Case "$G$7"
                With Target.Validation
                    .Delete
                    .Add Type:=xlValidateCustom, _
                    AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, _
                    Formula1:="IF(AND(XLOOKUP($F7,Merge1!$E$2#,XLOOKUP(G$6,Merge1!$F$1#,Merge1!$F$2:$V$25)),ISNUMBER(G7))=TRUE,TRUE,FALSE)"
                    .IgnoreBlank = True
                    .InCellDropdown = False
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = False
                    .ShowError = True
                End With

  ......
                
            Case Else
        End Select
        
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        
    End If
    
    '--------------------------------------------------------
    'Col H as target: change events related to Col H changes
            
    If Not Intersect(Target, rngH) Is Nothing Then
            
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        
        Select Case Target.Address

........
            

I have noted that the error msg and DV formula don't show up in the cell after the cells are changed via VBA (I have an additional feature to apply some math to certain cells at a specific instance).


EARLIER CODE (NO DV ERROR/ISSUE)

1) Empty cell/empty DV formula 2) Filled cell w/ no DV msg 3) Changed cell value w/ no DV msg or error

......

    'Col G as target: change events related to Col G changes
    
    If Not Intersect(Target, rngG) Is Nothing Then
            
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        
        Select Case myCell.Address
            
             Case "$G$7"
                With rngG.Validation
                    .Delete
                    .Add Type:=xlValidateCustom, _
                    AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, _
                    Formula1:="IF(AND(XLOOKUP($F7,Merge1!$E$2#,XLOOKUP(G$6,Merge1!$F$1#,Merge1!$F$2:$V$25)),ISNUMBER(G7))=TRUE,TRUE,FALSE)"
                    .IgnoreBlank = True
                    .InCellDropdown = False
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = False
                    .ShowError = True
                End With

......
...
......
           Case Else

       End Select
  
       With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        
    End If

................

Overall, I feel that this issue is a result of me making updates to the worksheet change code. I have added additional targets as well as changed the language a tiny bit to avoid other minor errors I was receiving before (was not receiving DV error before).

Update details:

I was getting an error/stop at the "Select Case myCell.Address" line before so I made the update to "target.Address" and then that led me to also change "...rngG.Validation.." (and the other ranges) to Target.Validation" as I was getting the DV error & msg in the all the cells of the column where a cell was being changed.

Other than that, I have just added/will add an additional column or more as target ranges.

Any help would be appreciated!


Solution

  • Your event handler doesn't handle multi-cell instances of Target, so put this at the top of your Sub -

    If Target.CountLarge > 1 Then Exit Sub

    The length of your posted code is going to put folks off from reviewing it. This for rngG is equivalent and much shorter:

        If Not Intersect(Target, rngG) Is Nothing Then
                
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
            End With
            
            With Target.Validation
                .Delete
                .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, _
                     Operator:=xlBetween, _
    Formula1:=Replace("=IF(AND(XLOOKUP($F<rw>,Merge1!$E$2#,XLOOKUP(G$6,Merge1!$F$1#,Merge1!$F$2:$V$25))," & _
                                  "ISNUMBER(G<rw>))=TRUE,TRUE,FALSE)", "<rw>", Target.Row)
                .IgnoreBlank = True
                .InCellDropdown = False
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = False
                .ShowError = True
            End With
                
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
            
        End If