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
Related
I am using a Excel VBA userform to change the font case as below picture. When RefEdit control have correct Range, then it is working fine. But if I click "Apply" button keeping RefEdit blank/ only Space/ any word(invalid Range), Userform disappear without showing any error notification.
For Uppercase code:-
Sub UpperCaseFont()
For Each x In Range(CaseRefEdit.Value)
If Not IsEmpty(x.Value) Then
x.Value = UCase(x.Value)
End If
Next
MsgBox "Done"
End Sub
LowerCase code:-
Sub LowerCaseFont()
For Each x In Range(CaseRefEdit.Value)
If Not IsEmpty(x.Value) Then
x.Value = LCase(x.Value)
End If
Next
MsgBox "Done"
End Sub
Propercase code:-
Sub ProperCaseFont()
For Each x In Range(CaseRefEdit.Value)
If Not IsEmpty(x.Value) Then
x.Value = WorksheetFunction.Proper(x.Value)
End If
Next
End Sub
CommandButton code:-
Private Sub CaseApplyCommandButton_Click()
If UpperCase = True Then Call UpperCaseFont
If LowerCase = True Then Call LowerCaseFont
If ProperCase = True Then Call ProperCaseFont
For that reason, I have tried to modified as below, But still i am facing the problem that if RefEdit is blank and I click on "Apply" button then userform disappear and also found that other all userform start unknown problem to initialize.
Private Sub CaseApplyCommandButton_Click()
'Font Case
Dim Rng As Range
On Error Resume Next
Set Rng = Range(Me.CaseRefEdit.Value)
MsgBox Rng
On Error GoTo 0
If Rng Is Nothing Then
MsgBox "Select the Cells to change the case"
Else
If UpperCase = True Then Call UpperCaseFont
If LowerCase = True Then Call LowerCaseFont
If ProperCase = True Then Call ProperCaseFont
End If
End Sub
I have found that problem is started when I add below code:-
Private Sub CaseRefEdit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Range(CaseRefEdit.Value).Select
End Sub
As per my understanding when RefEdit is not giving any range for input any number or word or keeping blank, then userform disappear. Any solution for this?
On the second question.
The [if IsError (range ("Hello") then ...] expression first evaluates the range ("Hello"), and if it is invalid, an error occurs before calling the function. Therefore, it is better to pass the address of the range to the IsError function, and calculate the range inside the function and determine its correctness.
Function IsError(addr As String) As Boolean
Dim rng As Range
On Error Resume Next
Set rng = Range(addr)
IsError = rng Is Nothing
End Function
Sub test1()
If IsError("%$%W34") Then
Debug.Print "Range is invalid"
Else
Debug.Print "Range is correct"
End If
End Sub
my problem is solved as below. Thanks #Алексей Р.
Private Sub CaseRefEdit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On error resume next
Range(CaseRefEdit.Value).Select
End Sub
Anyone know, how to check Range("etc")/ Range(123) is valid or not? Like-
If IsError(range("etc")) then
...
else
....
end if
You may use On Error statement, for example:
Function testRNG(addr As String) As Range ' returns correct Range object or Nothing otherwise
' initially testRNG = Nothing
On Error Resume Next
Set testRNG = Range(addr) ' if the address is correct, testRNG returns Range, otherwise an error occurs, the expression is not evaluated and testRNG remains Nothing
End Function
Sub foo()
Dim addr As String
addr = "W12"
Set Rng = testRNG(addr)
If Rng Is Nothing Then
Debug.Print "Address " & addr & " is wrong"
Else
Debug.Print "Range " & Rng.Address & " is correct"
End If
End Sub
The objective of this code is so every time cell E6:E36 changes from "Yes" or to "Enter Non Final Action Taken Date" I want it to run my macro.
It works only when E6 is marked to match the next value. How do I make it so it is not dependent on the previous cells value?
I'm new with VBA so I'm a bit lost. Any help would be greatly appreciated. See current code below:
Private Sub Worksheet_Change(ByVal Target As range)
Application.EnableEvents = False 'pervent triggering another change event
On Error GoTo ERR_HANDLING
If Not Intersect(Target, range("E6:E36")) Is Nothing Then
Select Case range("E6,E7,E8,E9,E10,E11,E12,E13,E14,E15,E16,E17,E18,E19,E20,E21,E22,E23,E24,E25,E26,E27,E28,E29,E30,E31,E32,E33,E34,E35,E36")
Case "Yes": EnterDate_of_last_Submission
End Select
End If
If Not Intersect(Target, range("E6,E7,E8,E9,E10,E11,E12,E13,E14,E15,E16,E17,E18,E19,E20,E21,E22,E23,E24,E25,E26,E27,E28,E29,E30,E31,E32,E33,E34,E35,E36")) Is Nothing Then
Select Case range("E6,E7,E8,E9,E10,E11,E12,E13,E14,E15,E16,E17,E18,E19,E20,E21,E22,E23,E24,E25,E26,E27,E28,E29,E30,E31,E32,E33,E34,E35,E36")
Case "Enter Non Final Action Taken Date": EnterNonFinal_Date
End Select
End If
On Error GoTo 0
ERR_HANDLING:
Application.EnableEvents = True
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContex
End If
End Sub
You need to loop here and compare cell-by-cell, something like the following:
Private Sub Worksheet_Change(ByVal Target As range)
Dim rngToCheck as Range
Set rngToCheck = Intersect(Target, Me.Range("E6:E36"))
If rngToCheck Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim rng as Range
For Each rng in rngToCheck
Select Case rng.Value
Case "Yes"
EnterDate_of_last_Submission
Case "Enter Non Final Action Taken Date"
EnterNonFinal_Date
End Select
Next
SafeExit:
Application.EnableEvents = True
End Sub
Most likely EnterDate_of_last_Submission and EnterNonFinal_Date should be rewritten to take a Range parameter, namely the cell the date is entered in (which it looks like would correspond to rng.Offset(,1) with your current setup.
I'm trying to make use of the Worksheet_Change event in VBA to return the value of the adjacent cell if current cell value is nothing, within provided range. I.e. IF current cell F3 is empty, then return contents in cell G3. This formula only applies to cells in range F3 to F37.
Here is my current code for which when any cell in range is empty, the code doesn't seem to evaluate (i.e. copy data from adjacent cell), and remains empty.
Any help would be greatly appreciated. Thanks!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Set myCell = Range("F3:F37")
If Not Application.Intersect(myCell, Range(Target.Address)) Is Nothing Then
Target.Value = Cell.Offset(0, 1).Value
End If
End Sub
Modified to:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Application.DisplayAlerts = False
Application.EnableEvents = False
Set myCell = Range("F3:F37")
If Not Application.Intersect(myCell, Range(Target.Address)) Is Nothing Then
If Target.Value = "" Then
Target.Value = Target.Offset(0, 1).Value
End If
End If
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
If you use Application.EnableEvents = False in an event make sure you use proper error handling and enable events again in case of any error within the event (VBA Error Handling – A Complete Guide). Otherwise your events will stay turned off in case of an error until you close the Excel application completely.
Note that Application.EnableEvents affects the whole application that means all Excel files that are opened in that instance of the application. So not having proper error handling here might have a bigger impact on other projetcts than you think.
Another trap you fell into, is that Target can be a Range (not only a single cell). So for example if you copy/paste a range that affects multiple cells in F3:F37 your Target is not a single cell and therefore Target.Value = "" does not work. You need a loop through all the affected cells:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CheckRange As Range
Set CheckRange = Me.Range("F3:F37") 'Make sure you use "Me" to refer to the same worksheet as Target (and the change event is in)
Dim AffectedCells As Range 'get the cells of CheckRange that were changed
Set AffectedCells = Application.Intersect(CheckRange, Target)
Application.EnableEvents = False
On Error GoTo ENABLE_EVENTS 'make sure you never end up in a condition where events stay disabled
If Not AffectedCells Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedCells 'loop throug all the affected cells
If Cell.Value = "" Then
Cell.Value = Cell.Offset(0, 1).Value
End If
Next Cell
End If
'no exit sub here!
ENABLE_EVENTS:
Application.EnableEvents = True
If Err.Number <> 0 Then 'make sure to re-raise an error message if there was an error (otherwise you won't ever notice that there was one), because the `On Error GoTo` statement muted the error message.
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
'above line to raise the original error message
'or at least show a message box:
'MsgBox "There was an error. Tell your Developer to fix it.", vbCritical
End If
End Sub
Note that I removed Application.DisplayAlerts because there is nothing in the code that would display any alerts, so I see no need to use it in this case here.
I want to clear the contents of the cell after clicking the ok button in a message pop up window.
When the pop up window disappears, after clicking ok button umpteen times, the script terminates by throwing the below error
Run time error '-2147417848(80010108)':
Method 'Range of object'_Worksheet'Failed
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("N4:O4")
If Not Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
If (Range("E9") = "" Or Range("F9") = "") Then
MsgBox "Reopen Date and Closed Date should not be populated before calculating the Benefit Begin Date and Maximum Benefit Date"
Sheets("Calculation Tool").Range("N4").Clear ----->Code written to clear the cells
Else
If (Range("N4") = "" Or Range("O4") = "") Then
Set b1 = Sheets("Calculation Tool").CommandButton22
b1.Enabled = False
Else
Set b1 = Sheets("Calculation Tool").CommandButton22
b1.Enabled = True
End If
End If
End If
End Sub
I wanted to tell #BigBen that his suggestion worked for me, but my low rep won't allow me to comment. The answer field is the only way of expression for me!
So I might as well formulate a valid answer, here it goes. :)
So I had the same problem within a Worksheet_Change event macro, in this casual event macro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RangeToCheck As Range
Set RangeToCheck = ActiveSheet.Range("O3:O32")
(above is the line that triggered randomly that Run time error '-2147417848(80010108)' you encountered; on with the script)
If Not Application.Intersect(Target, RangeToCheck) Is Nothing Then
Target.Value = VBA.Replace(Target.Value, ".", ",")
Debug.Print Target.Address, Target.Value
Else
Debug.Print "Not in RangeToCheck"
End If
End Sub
Following BigBen's link, I found that the following code works fine :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RangeToCheck As Range
On Error GoTo enableEventsOn:
Application.EnableEvents = False
Set RangeToCheck = ActiveSheet.Range("O3:O32")
Application.EnableEvents = True
On Error GoTo 0
If Not Application.Intersect(Target, RangeToCheck) Is Nothing Then
Target.Value = VBA.Replace(Target.Value, ".", ",")
Debug.Print Target.Address, Target.Value
Else
Debug.Print "Not in RangeToCheck"
End If
enableEventsOn:
Application.EnableEvents = True
End Sub
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.