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!
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