I want to improve whole code by adding MsgBox in case of:
Run-time error '1004': PasteSpecial method of Range class failed.
This Error is caused if clipboard is empty and I run the macro.
Any Advise?
Sub Test()
On Err.Number = 1004 GoTo ErrMsg
Dim Val As Variant
Sheets("Sheet 3").Select
Val = Range("A2").Value
Sheets("Sheet 1").Select
Call TextFromClipboard
Range("AY" & Val).Select
ActiveSheet.Paste
Sheets("Sheet 3").Select
ErrMsg:
MsgBox "Nothing to paste!", vbCritical, "Clipboard is empty!"
End Sub
Orgin
I always find it better to truly trap an error if it can be trapped, rather than relying on GoTo.
Based on this answer you can create a function to see if the clipboard is empty.
Function clipboardEmpty() as Boolean
'requires reference to Microsoft Forms 2.0 Object Library
Dim myDataObject As DataObject
Set myDataObject = New DataObject
myDataObject.GetFromClipboard
clipboardEmpty = Not myDataObject.GetFormat(1) = True
End Sub
You can then update your procedure to this:
If clipboardEmpty Then
Msgbox "No Data to Paste!"
Else
'Do Stuff
End If
Use a select case in the error handler to handle the error number not in the goto statement.
You could probably remove the need all together for that particular error by removing the selects and not using the clipboard.
Sub Test()
On Error GoTo ErrMsg
Dim Val As Variant
Sheets("Sheet 3").Select
Val = Range("A2").Value
Sheets("Sheet 1").Select
Call TextFromClipboard
Range("AY" & Val).Select
ActiveSheet.Paste
Sheets("Sheet 3").Select
Exit Sub
ErrMsg:
Select Case Err.Number
Case 1004
MsgBox "Nothing to paste!", vbCritical, "Clipboard is empty!"
End Select
End Sub
Related
Goal: Search range for cells containing errors, if found a modeless useform shows and allows you to change the sell to "yes", "no", or "Review later". If no cells with errors are found in range, msgbox appears to let you know, hide userform and exit sub.
Problem: I can not get the If range is nothing hide userform and exit sub to work properly. Whenever I reach the point where all the cell errors are dealt with I get a 1004 error on the range "no cells were found".
Sub UserformYes_no_review()
Dim Custchk As CustomListCheck
Set Custchk = VBA.UserForms.Add(CustomListCheck.Name)
With New CustomListCheck
Set CheckRange = Sheets("Sheet1").Range("A1:N2000").SpecialCells(xlCellTypeFormulas, xlErrors)
If CheckRange Is Nothing Then
MsgBox "All items have been accounted for"
CustomListCheck.Hide
Exit Sub
Else
For Each Cell In CheckRange
Cell.Select
If VarType(ActiveCell.Value) = vbError Then
Custchk.Show vbModeless
End If
Next Cell
End If
End With
End Sub
Private Sub CommandButton1_Click()
ActiveCell.Value = "Yes"
Call UserformYes_no
End Sub
Private Sub CommandButton2_Click()
ActiveCell.Value = "No"
Call UserformYes_no
End Sub
Private Sub CommandButton3_Click()
ActiveCell.Value = "Review Later"
Call UserformYes_no
End Sub
I have looked through a wealth of Stackoverflow pages and tried all the solutions that i could find and nothing is working.
As a side note, I used a userform over a msgbox as I needed this to be modeless.
When ever you are working with SpecialCells, use error handling.
Change
Set CheckRange = Sheets("Sheet1").Range("A1:N2000").SpecialCells(xlCellTypeFormulas, xlErrors)
to
On Error Resume Next
Set CheckRange = Sheets("Sheet1").Range("A1:N2000").SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
This solved the problem. There is still an issue where the userform will not hide, but I will post another question for this.
Sub UserformYes_no_review()
Dim Custchk As CustomListCheck
Set Custchk = VBA.UserForms.Add(CustomListCheck.Name)
Set CheckRange = Nothing
With New CustomListCheck
On Error Resume Next
Set CheckRange = Sheets("Sheet1").Range("A1:N2000").SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
If CheckRange Is Nothing Then
MsgBox "All items have been accounted for"
CustomListCheck.Hide
Exit Sub
Else
For Each Cell In CheckRange
Cell.Select
If VarType(ActiveCell.Value) = vbError Then
Custchk.Show vbModeless
End If
Next Cell
End If
End With
End Sub
I've written some code to launch workbooks if they exist in a specific folder based on cell entry. I'm having trouble displaying an error message when the entry is blank and/or when it doesn't exist in the file. I've tried using On Error GoTo MsgBox but the MsgBox would show up even though the entry was correct.
Private Sub Worksheet_Change(ByVal Target As Range)
'PART NUMBER DECLARATIONS
Dim part1 As Long
Dim part2 As Long
'Variable Assignments
part1 = 123
part2 = 234
If Target.Address = "$G$9" Then
varCellvalue = Range("G9").Value
Workbooks.Open "C:\Users\USERX\Desktop\Test File\" & varCellvalue & ""
ElseIF varCellvalue <> Range("G9").Value Then
MsgBox" Invalid Part Number"
End If
End Sub
Instead of using error handling, another approach would be to simply check if the file exists and then respond appropriately:
Private Sub Worksheet_Change(ByVal Target As Range)
'PART NUMBER DECLARATIONS
Dim part1 As Long
Dim part2 As Long
'Variable Assignments
part1 = 123
part2 = 234
If Target.Address = "$G$9" Then
varCellvalue = "C:\Users\USERX\Desktop\Test File\" & Range("G9").Value & ""
If Dir(varCellvalue) <> "" Then
Workbooks.Open varCellvalue
Else
MsgBox "The file does not exist"
End If
End If
End Sub
I think this approach is cleaner and perhaps more intuitive.
There are many ways to implement error handling. Here is one …
Private Sub Worksheet_Change(ByVal Target As Range)
'… rest of your code
On Error Goto ERR_FILE_OPEN
Dim Wb As Workbook
Set Wb = Workbooks.Open("C:\Users\USERX\Desktop\Test File\" & varCellvalue & "")
On Error Goto 0 'don't forget to re-enable error reporting
'… rest of your code
Exit Sub
ERR_FILE_OPEN:
MsgBox "File '" & varCellvalue & "' could not be opened.", vbCritical
End Sub
For more information read: VBA Error Handling – A Complete Guide.
Note that
If Target.Address = "$G$9" Then
is not a very reliable method to test if the cell G9 was changed. Instead always use the intersect method to test if a range was changed:
If Not Intersect(Me.Range("G9"), Target) Is Nothing Then
varCellvalue = Me.Range("G9").Value
There is many of approaches of implementing error detection, here are a couple of popular ones.
The Try-Catch approach
' The "Try" part
On Error Resume Next
...
On Error GoTo 0
' The "Catch" part
If Err.Number <> 0 Then
...
End If
The On error Goto approach
on error goto Oops
..
..
..
Exit Sub
Oops:
'handle error here
End Sub
For a comprehensive approach, refer to further reading "VBA Error Handling – A Complete Guide." provided by PEH.
I am searching for a blank cell in a table. Want to have a msg or run a command when there is no blank cell. I tried below versions but none of them worked
Sub Macro1()
ActiveSheet.ListObjects("Tabel1").DataBodyRange.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
On Error GoTo Line1
Line1:
MsgBox "no blank cell is found"
End Sub
and also this one
Sub Macro1()
ActiveSheet.ListObjects("Tabel1").DataBodyRange.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
If Selection = "" Then
MsgBox "no blank cell is found"
End If
End Sub
I suggest to catch the error and check if BlankCells is Nothing.
Sub Macro1()
Dim BlankCells As Range
On Error Resume Next 'supress all error messages until …Goto 0
Set BlankCells = ActiveSheet.ListObjects("Tabel1").DataBodyRange.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0 'never forget to re-activate error reporting immedeately!
If BlankCells Is Nothing Then
MsgBox "no blank cell is found"
Else
MsgBox BlankCells.Cells.Count & " blank cell(s) found"
End If
End Sub
You might benefit from reading …
How to avoid using Select in Excel VBA.
VBA Error Handling – A Complete Guide
No need for selects and selection, you could try:
Sub try()
On Error GoTo noblanks
MsgBox ActiveSheet.ListObjects("Tabel1").DataBodyRange.SpecialCells(xlCellTypeBlanks).Count & " blank cells are found"
Exit Sub
noblanks:
MsgBox "no blank cell is found"
End Sub
I have a worksheet in Excel with the name "Control". I'm receiving a msgbox saying it doesn't exists. After I click on "OK" I get an error of "invalid call of function or procedure and the debugger stops in this function:
Private Sub ClearData(dataSheet As Worksheet)
'On Error Resume Next
'dataSheet.rows(DataRow1 & ":" & dataSheet.rows.Count).SpecialCells(xlCellTypeConstants).ClearContents
Sheets(dataSheet).UsedRange.ClearContents
End Sub
This function is used to clear the worksheet and the code before 'dataSheet.rows(DataRow1 & ":" & dataSheet.rows.Count).SpecialCells(xlCellTypeConstants).ClearContents is commented because is raises error and I decided to modify to the line Sheets(dataSheet).UsedRange.ClearContents but the problem persists.
EDIT ClearData is called with this code:
Public Sub Init(rowNr As Integer, copyMap As CopyActionsMap, dataSheet As Worksheet)
m_configRowNr = rowNr
Set m_dataSheet = dataSheet
m_dataRowNr = FindDataRow
m_dataSheet.Cells(m_configRowNr, 1).Select 'select first cell in config row
If (Not m_initialized) Then Set m_columnCopyConfigs = GetColumnCopyConfigs(copyMap) 'also sets m_count
ClearData (m_dataSheet) 'Clean the existing data Now it says "object doenst support this method or property" after this: Private Sub ClearData(dataSheet As Worksheet) Sheets(dataSheet).Cells.Delete
End Sub
As #tigeravatar has mentioned in the comments below your question, you are trying to use a worksheet object as a string variable.
Try changing your code to
Private Sub ClearData(dataSheet As Worksheet)
'On Error Resume Next
'dataSheet.rows(DataRow1 & ":" & dataSheet.rows.Count).SpecialCells(xlCellTypeConstants).ClearContents
dataSheet.UsedRange.ClearContents
End Sub
If you want to clear the sheet by a specific string name instead, you should change your code to
Private Sub ClearData(dataSheet As String)
'On Error Resume Next
'dataSheet.rows(DataRow1 & ":" & dataSheet.rows.Count).SpecialCells(xlCellTypeConstants).ClearContents
Sheets(dataSheet).UsedRange.ClearContents
End Sub
And you can then clear the sheet named "Test Sheet" by calling
ClearData "Test Sheet"
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Does the validation range still have validation?
If Not HasValidation(Range("A1:A1048576")) Then RestoreValidation
If Not HasValidation(Range("C1:C1048576")) Then RestoreValidation
If Not HasValidation(Range("I1:I1048576")) Then RestoreValidation
If Not HasValidation(Range("P1:P1048576")) Then RestoreValidation
End Sub
Private Sub RestoreValidation()
Application.EnableEvents = False
'turn off events so this routine is not continuously fired
Application.Undo
Application.EnableEvents = True
'and turn them on again so we can catch the change next time
MsgBox "Your last operation was canceled." & _
"It would have deleted data validation rules.", vbCritical
End Sub
Private Function HasValidation(r) As Boolean
' Returns True if every cell in Range r uses Data Validation
On Error Resume Next
Debug.Print r.Validation.Type 'don't care about result, just possible error
If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function
I applied validation on 4 columns with the above code, Even the validation is passed I am getting 4 error pop up messages how to restrict number of error messages ?
UPDATE:
I selected the value from the drop down which is a valid selection, but I am getting the below error message.
I am using the following code
If you are working with the sheet's Change event, then I would recommend having a look at THIS
Since you are working with just one sheet then you don't need the code in the ThisWorkbook code area. If you put it there then the code will run for every sheet. Put the code in the relevant sheet's code area. So if the validation is in Sheet1 then put the code in the Sheet1 code area. See ScreenShot below.
Ok now to address your query. What you can do is use a Boolean variable and then set it to True after you show the first message so that the message doesn't show again.
Try this (UNTESTED)
Dim boolDontShowAgain As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not HasValidation(Range("A1:A1048576")) Then RestoreValidation
If Not HasValidation(Range("C1:C1048576")) Then RestoreValidation
If Not HasValidation(Range("I1:I1048576")) Then RestoreValidation
If Not HasValidation(Range("P1:P1048576")) Then RestoreValidation
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Private Sub RestoreValidation()
Application.Undo
If boolDontShowAgain = False Then
MsgBox "Your last operation was canceled." & _
"It would have deleted data validation rules.", vbCritical
boolDontShowAgain = True
End If
End Sub
Private Function HasValidation(r) As Boolean
On Error Resume Next
Debug.Print r.Validation.Type
If Err.Number = 0 Then HasValidation = True
End Function