Detect paste into cell with data validation list

I have the below worksheet change code. The purpose of the code is to review whether any of the cells have a data validation list and prevent paste into that specific cell. The code loops through each cell in the paste range and adds the content into an array. Then it loops through each cell in the paste range again and identified if the cell contains a data validation list. If the cell does not contain a validation list, then the content is placed back in from the array. If it contains a validation list, then a message is displayed, and the value is not added back in. I have tested the code multiple times by pasting into two or three cells with at least one cell containing a validation list. When I have tested the code it all functions correctly except detecting a validation list. The results are each cell in the paste range is pasted into even when the cell contains a validation list. Or each cell is treated as having a validation list even when it does not. In the below code the various ways I have written it with the results have been commented out.

I would appreciate a fresh set of eyes to look at this and tell me if:
1. What I am trying to accomplish is possible.
2. Where my code is written in correctly.
3. Any other alternatives or suggestions.

Thank you for your time in reviewing and responding.

Set vRng = Me.Cells.SpecialCells(xlCellTypeAllValidation)
i = 1
For Each aCell In Range(PasteRng).Cells
PasteValueArr(i) = aCell
i = i + 1
Next aCell

Application.Undo

j = 1
For Each aCell In Range(PasteRng)
'If Intersect(aCell, vRng) Is Nothing Then '***EACH CELL TREATED AS HAVING VALIDATION LIST
'If aCell.Validation.Type = 3 Then 'xlValidateList '***EACH CELL TREATED AS HAVING VALIDATION LIST
'If Not Intersect(aCell, vRng) Is Nothing Then '***PASTES OVER VALIDATION LIST
'If Not Intersect(Target, vRng) Is Nothing Then '***EACH CELL TREATED AS HAVING VALIDATION LIST
If Target.Validation.Type = 3 Then 'xlValidateList '***EACH CELL TREATED AS HAVING VALIDATION LIST
MsgBox "A cell or cells selected contain a dropdown list which" _
& " information can not be paste into. Please select directly from the dropdown list." _
& " The information which was pasted in was be removed.", vbInformation, "Paste feature"
Else
aCell = PasteValueArr(j)
With aCell
.Font.Size = 12
.Font.Name = "Arial"
.Font.FontStyle = "regular"
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Locked = False
End With
End If
j = j + 1
Next aCell

Not easy to diagnose the issue when the code is incomplete (we have no idea how "PasteRng" is defined among other things) and when we cannot see the problem in context (no idea of data layout etc.)

Attaching a desentitized sample workbook would be a great start to you getting a useful response on this.

BSB

Thank you BSB for your response. Below please find the section of code which pertains to my post.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim UndoList As String
Dim LastAction As Variant
Dim sh1 As Worksheet
Dim tbl As ListObject
Dim RowRef, ColRef As Integer

'Call SheetUnprotect

Set sh1 = Sheet1
Set tbl = sh1.ListObjects(1)
Set HeaderRng = tbl.HeaderRowRange

RowRef = ActiveCell.Row 'IDENTIFIES AND STORES THE ROW NUMBER INITALLY SELECTED AS ROWREF
ColRef = ActiveCell.Column 'IDENTIFIES AND STORES THE COLUMN NUMBER INITIALLY SELECTED AS COLREF3/3/

Application.EnableEvents = False
Application.ScreenUpdating = False
'_________________________________________________________________________________________
' ~~' Code adapted from stackoverflow https://stackoverflow.com/questions/...in-a-worksheet
'~~'Forum question "Excel VBA How to detect if something was pasted in a Worksheet' Updated 2/3/22 by David

Dim barFound As Boolean
Dim index As Long

'SETTING LASTACTION AND BARFOUND TO FALSE
LastAction = False
index = 1
barFound = False

Do While barFound = False
If Application.CommandBars(index).Name = "Standard" Then
barFound = True
Else
index = index + 1
End If
Loop

On Error Resume Next
UndoList = Application.CommandBars(index).Controls(14).List(1)

'~~' CHECKS IF THE LAST ACTION WAS A PASTE OR PASTE SPECIAL
If UndoList = "Paste" Or UndoList = "Paste Special" Then
LastAction = True
Else
LastAction = False
End If
'____________________________________________________________
If LastAction = False Then GoTo DataValidation

Dim PasteRng As String, vRng As Range, rng As Range, aCell As Range
Dim PasteCellCt As Long, PasteRowCt As Long
Dim PasteValeuArr() As Variant
Dim i As Long, j As Long, v As Long

If LastAction = True Then
PasteCellCt = Selection.Cells.Count
PasteRowCt = Selection.Row.Count
PasteRng = Selection.Address
ReDim PasteValueArr(1 To PasteCellCt)
End If

'Get a range of ONLY the validation cells
Set vRng = Me.Cells.SpecialCells(xlCellTypeAllValidation)
i = 1
For Each aCell In Range(PasteRng).Cells
PasteValueArr(i) = aCell
i = i + 1
Next aCell

Application.Undo 'USE UNDO VERSE CLEAR CONTENTS TO REMOVE ANY FORMATTING WHICH WAS PASTE IN

j = 1
For Each aCell In Range(PasteRng)
'If Intersect(aCell, vRng) Is Nothing Then '***EACH CELL TREATED AS HAVING VALIDATION LIST
'If aCell.Validation.Type = 3 Then 'xlValidateList '***EACH CELL TREATED AS HAVING VALIDATION LIST
'If Not Intersect(aCell, vRng) Is Nothing Then '***PASTES OVER VALIDATION LIST
'If Not Intersect(Target, vRng) Is Nothing Then '***EACH CELL TREATED AS HAVING VALIDATION LIST
If Target.Validation.Type = 3 Then 'xlValidateList '***EACH CELL TREATED AS HAVING VALIDATION LIST
MsgBox "A cell or cells selected contain a dropdown list which" _
& " information can not be paste into. Please select directly from the dropdown list." _
& " The information which was pasted in was be removed.", vbInformation, "Paste feature"
Else
aCell = PasteValueArr(j)
With aCell
.Font.Size = 12
.Font.Name = "Arial"
.Font.FontStyle = "regular"
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Locked = False
End With
End If
j = j + 1
Next aCell
GoTo exitHandler

Additional code follows which allows multiple selection from the drop down lists.

Thank you for your help.

I have solved this issue. I found an old posting https://www.excelforum.com/excel-gen...tion-cell.html with a suggesting sub and function.
This is the code suggested by Shijesh Kumar:

Private Sub Worksheet_Change(ByVal Target As Range)

If HasValidation(Range(ActiveCell.Address)) Then
Exit Sub
Else
Application.Undo
MsgBox "Your last operation was canceled." & _
"It would have deleted data validation rules.", vbCritical
End If
End Sub

Private Function HasValidation(r) As Boolean
On Error Resume Next
x = r.Validation.Type
If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function

I have added the function to the worksheet and have used the line of his code "If HasValidation(Range(ActiveCell.Address)) Then" and changed ActiveCell.Address to aCell.Address. The code now distinguishes between cells with a validation list and those without.