mcullen6075
New Member
- Joined
- Sep 1, 2013
- Messages
- 1
Hello,
I was just looking for some help with some issues I have encountered with some VBA code I have. Unfortunately I am not at all familiar with VBA and I have simply taken bits and pieces of code from various places on the internet and now I need some help sorting some things out.
My first question is: with my code below why can I not delete or clear the contents of cells and how do I allow for cells to be deleted or cleared?
My Second Question is why do I get a "Subscript out of range" error, and how do I fix this?
Thank you in advance
Below is my code:
This first bit of code is in a sheet and allows me to check to make sure pasted values are consistent with a data validation list:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim IsDV As Boolean
If Not Intersect(Target, Range("Electricity_Consumption_Units_Overwrite")) Is Nothing Then
On Error Resume Next
IsDV = Target.SpecialCells(xlCellTypeAllValidation).Cells.Count > 0
On Error GoTo 0
Application.EnableEvents = False
On Error GoTo ReEnable
If IsDV Then
If Evaluate(Target.Validation.Formula1).Find(Target, , , 1, , , 0) Is Nothing Then
MsgBox "Cannot paste values not within the list. ", vbExclamation, "Invalid Entry"
Application.Undo 'Not within the DV list
End If
Else
MsgBox "Cannot paste over the data validation cell. ", vbExclamation, "Invalid Paste"
Application.Undo 'Pasted over the DV cell
End If
End If
ReEnable:
Application.EnableEvents = True
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & vbLf & Err.Description, _
vbCritical, "Worksheet_Change Procedure Error"
Err.Number = 0
End If
End Sub
This next bit of code makes all pastes a value and is in the entire workbook:
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim UndoList As String
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo Whoa
'~~> Get the undo List to capture the last action performed by user
UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
'~~> Check if the last action was not a paste nor an autofill
If Left(UndoList, 5) <> "Paste" And UndoList <> "Auto Fill" Then GoTo LetsContinue
'~~> Undo the paste that the user did but we are not clearing the clipboard
'~~> so the copied data is still in memory
Application.Undo
If UndoList = "Auto Fill" Then Selection.Copy
'~~> Do a pastespecial to preserve formats
On Error Resume Next
'~~> Handle text data copied from a website
Target.Select
ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
On Error GoTo 0
'~~> Retain selection of the pasted data
Union(Target, Selection).Select
LetsContinue:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
I was just looking for some help with some issues I have encountered with some VBA code I have. Unfortunately I am not at all familiar with VBA and I have simply taken bits and pieces of code from various places on the internet and now I need some help sorting some things out.
My first question is: with my code below why can I not delete or clear the contents of cells and how do I allow for cells to be deleted or cleared?
My Second Question is why do I get a "Subscript out of range" error, and how do I fix this?
Thank you in advance
Below is my code:
This first bit of code is in a sheet and allows me to check to make sure pasted values are consistent with a data validation list:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim IsDV As Boolean
If Not Intersect(Target, Range("Electricity_Consumption_Units_Overwrite")) Is Nothing Then
On Error Resume Next
IsDV = Target.SpecialCells(xlCellTypeAllValidation).Cells.Count > 0
On Error GoTo 0
Application.EnableEvents = False
On Error GoTo ReEnable
If IsDV Then
If Evaluate(Target.Validation.Formula1).Find(Target, , , 1, , , 0) Is Nothing Then
MsgBox "Cannot paste values not within the list. ", vbExclamation, "Invalid Entry"
Application.Undo 'Not within the DV list
End If
Else
MsgBox "Cannot paste over the data validation cell. ", vbExclamation, "Invalid Paste"
Application.Undo 'Pasted over the DV cell
End If
End If
ReEnable:
Application.EnableEvents = True
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & vbLf & Err.Description, _
vbCritical, "Worksheet_Change Procedure Error"
Err.Number = 0
End If
End Sub
This next bit of code makes all pastes a value and is in the entire workbook:
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim UndoList As String
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo Whoa
'~~> Get the undo List to capture the last action performed by user
UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
'~~> Check if the last action was not a paste nor an autofill
If Left(UndoList, 5) <> "Paste" And UndoList <> "Auto Fill" Then GoTo LetsContinue
'~~> Undo the paste that the user did but we are not clearing the clipboard
'~~> so the copied data is still in memory
Application.Undo
If UndoList = "Auto Fill" Then Selection.Copy
'~~> Do a pastespecial to preserve formats
On Error Resume Next
'~~> Handle text data copied from a website
Target.Select
ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
On Error GoTo 0
'~~> Retain selection of the pasted data
Union(Target, Selection).Select
LetsContinue:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub