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
Related
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
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 have a format of table which is with filters and I made the filter to filter all the table based on the cells in column D3 that with value not blank. Now I am trying to make the filter work automatically based on any change on the list on cell G1.
I tried to use the pivot table but this did not work, as this type of table is not part of pivot table (formatted as table).
What is the correct code that can be used for such sorting?
The sheet is Sheet 1, the table named (PT).
The following code will be activated only if the value in G1 is changed.
Open VBE using Alt+F11, open "Sheet 1" module and paste the given code.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errH
If Not Intersect(Target, Me.Range("G1")) Is Nothing Then
Application.EnableEvents = False
'Put here things that you want to be done if G1 value is changed
'For example:
MsgBox "G1 was changed."
Application.EnableEvents = True
End If
Exit Sub
errH:
MsgBox ("Error number: " & Err.Number & ". Description: " & Err.Description)
Application.EnableEvents = True
End Sub
You can test it - just change the G1 value and you will see that it works.
However, I do not understand your explanation about what you want to filter. But whatever it is, just put the code in the place which I identified and remove that MsgBox.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim criteriaparameter As String
Dim criteriavalue As String
On Error GoTo errH
If Not Intersect(Target, Me.Range("G1")) Is Nothing Then
Application.EnableEvents = False
criteriaparameter = ActiveSheet.Range("J1").Value
criteriavalue = ">=" & criteriaparameter
ActiveSheet.Range("$A$8:$L$8").AutoFilter Field:=10, Criteria1:=criteriavalue, _
Operator:=xlAnd
Application.EnableEvents = True
End If
Exit Sub
errH:
MsgBox ("Error number: " & Err.Number & ". Description: " & Err.Description)
Application.EnableEvents = True
End Sub
I have been trying to check if two cells are empty. I know how to check for one cell but I can't get to figure out how to check two separate cells. This is one of the ways I have tried. When I run it, it will only check for F17 but not for F12, if I switch the numbers it will check only for F12. I appreciate any help. Thank you
Sub Button11VerifyFilePathPresent_Click()
Dim rCell As Range
On Error GoTo ErrorHandle
Set rCell = Range("F17", "F12")
If IsEmpty(rCell) Then
MsgBox "Please select the files" ' "Cell " & rCell.Address & " is empty."
End If
BeforeExit:
Set rCell = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Error in procedure CellCheck."
Resume BeforeExit
End Sub
Consider:
If Range("F17") & Range("F12") = "" Then
If the concatenation is null, then they both must be null.
I know that in VBA, we can do
Cells(4, 2).Value = 100 'the cell is an integer
Cells(4, 2).Value = True 'the cell is Boolean
Cells(4, 2).Value = "abc" 'the cell is Text
Is it possible to fix or declare the type of a cell, for instance, let Cells(4,2) accept only Boolean, such that assigning an Integer or Text to Cells(4, 2) gives an error?
[EDIT This solution can be implemented from VBA, but it cannot be used from VBA, i.e. can't prevent VBA user from setting cell value to be anything (though not manually in Excel sheet). Not sure what the OP actually wants.]
Use Data Validation.
You can do it via VBA:
Range("A1").Validation.Add Type:=xlValidateList, Formula1:="TRUE,FALSE"
or manually: (In Excel 2003: Data > Validation...)
Now you can enter only boolean TRUE or FALSE in cell A1. If you try to enter something else, e.g. a number:
Using data validation, you can also restrict the cell to accept only numbers, only integers, text of a certain length, basically anything. For example, to accept only text and not numbers, you would use Allow: Custom, Formula: =NOT(ISNUMBER(A1)).
If you actually want the cell type to be specified, you can't. All cells in VBA contain variant data types, to the best of my knowledge.
If you mean the data type of the variant, then sure, you can do it one way or another. Here's a suggestion, it's a little quick and dirty but it works. You'll need to put it in your worksheet code module. Note that it doesn't test if your bool range, int range, whatever intersect, that could cause you some problems if they do.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo handler
Dim cell As Range, _
boolRng As Range, _
intRng As Range
Set boolRng = Union(Sheet1.Range("A1:B2"), Sheet1.Range("E:E"))
Set intRng = Union(Sheet1.Range("B7:K12"), Sheet1.Range("M:M"))
If Not Intersect(Target, boolRng) Is Nothing Then
For Each cell In Intersect(Target, boolRng)
If cell.Value <> "" Then
cell.Value = CBool(cell.Value)
End If
Next cell
End If
If Not Intersect(Target, intRng) Is Nothing Then
For Each cell In Intersect(Target, intRng)
If cell.Value <> "" Then
cell.Value = CInt(cell.Value)
End If
Next cell
End If
Exit Sub
handler:
Select Case Err.Number
Case 13 'Type mismatch, raised when cint/cbool/c*** fails
cell.Value = ""
Resume Next
Case Else
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
End Sub
Edit: I note you want to raise an error if the value is assigned incorrectly, you can do that in the error handling section. Instead of
Cell.value = ""
Resume Next
You could use
Err.Raise ISuggestAnEnumForErrorNumbers, "Sheet1.Worksheet_Change(Event)", "Attempted to assign wrong type to cell."
I second JFC's suggestion on using Data Validation.
To test it, place this code in a module (TRIED AND TESTED)
Sub Sample()
With Sheets("Sheet1").Range("A1")
.Validation.Delete
.Validation.Add Type:=xlValidateList, Formula1:="TRUE,FALSE"
.Value = "SID"
End With
End Sub
and this in the relevant sheet
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.EnableEvents = False
On Error Resume Next
If Not Target.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
Dim currentValidation As Excel.Validation
Set currentValidation = Target.Validation
If currentValidation.Type = xlValidateList Then
'~~> I am using INSTR. If you want you can split it using "," as delim
'~~> and check for the value.
If Not InStr(1, currentValidation.Formula1, Target.Value, vbTextCompare) Then
MsgBox "Incorrect Value"
Target.ClearContents
End If
End If
End If
On Error GoTo 0
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
Now try running the Sub Sample() in the module.