I have an excel table with a column named "Completed?" that users select Yes or No from the drop down. If they Select Yes a Message Box using vbOKCancel pops up. If they confirm Yes that part is working so far, but if anything else happens (they hit Cancel, or X out, etc) I want this field to be changed to "No" - this is what I'm struggling with.
It seems like it should be simple - any ideas?
If Target.Column = 3 And Target.Value = "Yes" Then
Dim answer As Integer
answer = MsgBox("Are you sure you want to mark this as Completed? This will move the record to the Completed Tab and cannot be undone.", vbOKCancel + vbCritical, "CRITICAL WARNING")
If answer = vbOK Then MsgBox ("OK")
'need help with this next row
Else: Target.Value = "No"
End If
End Sub
Fundimentaily, you issue is missuse of the If Then Else End IF structure. (you are mixing Multi Line and Single Line syntax)
See here for more details
There are some other issues too, see inline comments
Private Sub Worksheet_Change(ByVal Target As Range)
Dim answer As VbMsgBoxResult ' use correct data type
Dim rng As Range, cl As Range
On Error GoTo EH ' ensure events get turned back on
Application.EnableEvents = False ' prevent event cascade
Set rng = Application.Intersect(Target, Me.Columns(3)) ' get all cells in column 3 that changed
For Each cl In rng ' process each changed cell
If LCase(cl.Value) = "yes" Or LCase(cl.Value) = "y" Then ' case insensitive
answer = MsgBox("Are you sure you want to mark row " & cl.Row & " as Completed?" & vbNewLine & vbNewLine & "This will move the record to the Completed Tab and cannot be undone.", vbOKCancel + vbCritical, "CRITICAL WARNING")
If answer = vbOK Then
cl.Value = "Yes" ' Standardise case
' MsgBox "OK" ' this is a bit annoying
Else
cl.Value = "No"
End If
End If
Next
EH:
Application.EnableEvents = True
End Sub
try this:
If Target.Column = 3 And Target.Value = "Yes" Then
Dim answer As Integer
answer = MsgBox("Are you sure you want to mark this as Completed? " & _
"This will move the record to the Completed Tab and cannot be undone.", vbOKCancel + vbCritical, "CRITICAL WARNING")
If answer = vbOK Then
MsgBox ("OK")
Else
Target.Value = "No"
End If
End If
Related
I have a handy function that's called from cell C1 that populates the cell with the filters that have been applied to Column C using the filters dropdown: =ShowColumnFilter(C:C)
As soon as the user clicks OK in the dropdown, the cell displays the filter(s).
However, when I apply a filter to that same column using VBA below from a command button or hyperlink, the column is correctly filtered but the Function ShowColumnFilter returns an error.
'Code Snippet:
With ActiveSheet.Range("A:W")
.AutoFilter Field:=3, Criteria1:="Some Criteria Here"
End With
Function ShowColumnFilter(rng as Range)
'Only the relevant code included here. Works fine when filtering through dropdown, but gives error after applying filter through the VBA in Worksheet_FollowHyperlink.
Dim sh As Worksheet
Dim frng As Range
Set sh = rng.Parent
Debug.Print sh.FilterMode
'When filtered from UI dropdown OR after executing VBA Code Snippet from Worksheet_FollowHyperlink returns TRUE
Debug.Print sh.AutoFilter.FilterMode
'When filtered from UI dropdown returns TRUE but after executing VBA from hyperlink or command button creates an error: "Object variable or With block variable not set"
Set frng = sh.AutoFilter.Range 'Errors only after filtering by executing VBA from separate routine
...
End Function
This one has me perplexed because the function ShowColumnFilter is populating a cell and is not invoked directly by another sub. I'm trying to populate C1 with the filtering that has been applied to the column regardless of how the user filtered it. Any help is greatly appreciated.
Full code here:
Function ShowColumnFilter(rng As Range)
On Error GoTo myErr
'> PURPOSE: Show filters used in a specific column _
USAGE: =ShowColumnFilter(C:C)
Dim filt As Filter
Dim sCrit1 As String
Dim sCrit2 As String
Dim sOp As String
Dim lngOp As Long
Dim lngOff As Long
Dim frng As Range
Dim sh As Worksheet
Dim i As Long
Set sh = rng.Parent
If sh.FilterMode = False Then
ShowColumnFilter = "No Active Filter"
Exit Function
End If
'**** Included only for debugging *****
Debug.Print sh.FilterMode
Debug.Print sh.AutoFilter.FilterMode
'**************************************
Set frng = sh.AutoFilter.Range
If Intersect(rng.EntireColumn, frng) Is Nothing Then
ShowColumnFilter = CVErr(xlErrRef)
Else
lngOff = rng.Column - frng.Columns(1).Column + 1
If Not sh.AutoFilter.Filters(lngOff).On Then
ShowColumnFilter = "No Conditions"
Else
Set filt = sh.AutoFilter.Filters(lngOff)
On Error Resume Next
lngOp = filt.Operator
If lngOp = xlFilterValues Then
For i = LBound(filt.Criteria1) To UBound(filt.Criteria1)
sCrit1 = sCrit1 & filt.Criteria1(i) & " or "
Next i
sCrit1 = Left(sCrit1, Len(sCrit1) - 3)
Else
sCrit1 = filt.Criteria1
sCrit2 = filt.Criteria2
If lngOp = xlAnd Then
sOp = " And "
ElseIf lngOp = xlOr Then
sOp = " or "
Else
sOp = ""
End If
End If
ShowColumnFilter = sCrit1 & sOp & sCrit2
End If
End If
myExit:
Exit Function
myErr:
Call ErrorLog(Err.Description, Err.Number, "GlobalCode", "ShowColumnFilter", True)
Resume myExit
End Function
Sub ErrorLog(strErrDescription As String, lngErrNumber As Long, strSheet As String, strSubName As String, bolShowError As Boolean)
On Error GoTo myErr
'> PURPOSE: Record Errors in an Error Log
If bolShowError = True Then _
MsgBox "An error has occured running " & strSubName & " on worksheet " & strSheet & ": " & Err.Number & " - " & Err.Description, vbInformation, "VBA Error"
myExit:
Exit Sub
myErr:
MsgBox "VBA Error - Error Log: " & Err.Number & " - " & Err.Description
Resume myExit
End Sub
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
On Error GoTo myErr
'> PURPOSE: Fires whenever a hyperlink is clicked on Sheet 1
Dim sValue as String
sValue = "Some Useful Criteria"
'> Select the sheet:
Sheets("MySheetName").Select
With ActiveSheet.Range("A:W")
If Len(sValue) > 0 Then _
.AutoFilter Field:=3, Criteria1:=sValue
End With
'> Go to the top row:
ActiveWindow.ScrollRow = 1
myExit:
Exit Sub
myErr:
Call ErrorLog(Err.Description, Err.Number, "Sheet1", "FollowHyperlink", True)
Resume myExit
End Sub
It looks like the problem you're running into is linked to exactly when your ShowColumnFilter function is running. As a UDF, it's executed when the worksheet is recalculated. Applying an AutoFilter kicks off a recalculation. So if you catch the call stack in your Worksheet_FollowHyperlink routine, you can detect that the ShowColumnFilter function is entered immediately following the .AutoFilter Field:=3, Criteria1:=sValue statement. So your function is actually catching the worksheet and the filter in a somewhat unknown state.
I was able to solve this issue by protecting that section of code by disabling events and automatic calculations:
Sub ApplyTestFilter()
'Hyperlink Code Snippet:
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With ActiveSheet.Range("A:W")
.AutoFilter Field:=2, Criteria1:=">500"
End With
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
This forces the automatic calculations to delay until you've completed your filtering. (NOTE: in some cases you might have to explicitly force the worksheet to recalculate, though I didn't encounter that situation in my small test.)
Thanks to these instructions
How do I assign a Macro to a checkbox dynamically using VBA
https://social.msdn.microsoft.com/Forums/office/en-US/877f15da-bbe4-4026-8ef2-8df77e1022f7/how-do-i-assign-a-macro-to-a-checkbox-dynamically-using-vba?forum=exceldev
I came up with an idea to:
Put checkboxes where I want on the sheet, e.g. in columns to the right from table with data for processing
Connect their (un)checking with logical variables which are used whether to start or not to start some procedures.
Wait for user to make his choices and check certain checkbox (e.g. the last in the list) to start selected procedures
Remove all (!) checkboxes and start the procedures selected shortly before.
This way the macros containing optional procedures are portable, as they don't DEPEND on the opened files but only WORK on them.
The files themselves remain unchanged by these free from control buttons coded in the macro (i.e. the sheet with checkboxes returns to it's previous state).
The following macro makes its own checkboxes (in column H), waits for user to choose options, memorizes choices, deletes all checkboxes, runs other procedures... and ends up without leaving a trace of itself in a workbook.
Dim FirstOptionLogical, SecondOptionLogical, ThirdOptionLogical As Boolean
' Making new checkboxes
Sub CheckBOxAdding()
Dim i As Long, id As Long
Dim cel As Range
Dim cbx As CheckBox
On Error GoTo CheckBoxAddingERROR
'FirstOptionLogical = False
'SecondOptionLogical = False
'ThirdOptionLogical = False
' Deleting all checkboxes, if any found
' Preventing error stops if there is no checkbox
On Error Resume Next
' Repeating with all checkboxes on active sheet
For Each chkbx In ActiveSheet.CheckBoxes
' Removing a checkbox
chkbx.Delete
' Next checkbox
Next
Range("G3").Select
ActiveSheet.Range(Columns("G:G"), Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
On Error GoTo 0
Set cel = ActiveSheet.Cells(3, 8)
With cel
Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
End With
cbx.Name = "Option_1"
cbx.Caption = "First Attribute changes, name it"
cbx.Display3DShading = True
' with a linked can trap sheet change event or link to other formulas
cbx.LinkedCell = cel.Offset(0, -1).Address
cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
''''''''''
Set cel = ActiveSheet.Cells(5, 8)
With cel
Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
End With
cbx.Name = "Option_2"
cbx.Caption = "Second Attribute changes, name it"
cbx.Display3DShading = True
' with a linked can trap sheet change event or link to other formulas
cbx.LinkedCell = cel.Offset(0, -1).Address
cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
Set cel = ActiveSheet.Cells(7, 8)
With cel
Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
End With
cbx.Name = "Option_3"
cbx.Caption = "Third Attribute changes, name it"
cbx.Display3DShading = True
' with a linked can trap sheet change event or link to other formulas
cbx.LinkedCell = cel.Offset(0, -1).Address
cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
Set cel = ActiveSheet.Cells(9, 8)
With cel
Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' .Font.Size = 36
' height will autosize larger to the font
End With
cbx.Name = "Option_4"
cbx.Caption = "START THE MACRO"
cbx.Display3DShading = True
' with a linked can trap sheet change event or link to other formulas
cbx.LinkedCell = cel.Offset(0, -1).Address
cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
Exit Sub
CheckBoxAddingERROR:
MsgBox "Something went wrong... ;-) in the sub CheckBOxAdding", vbCritical + vbOKOnly
End
End Sub
Sub CheckBoxHandling()
Dim sCaller, UsersChoice As String
Dim id As Long
Dim cbx As CheckBox
Dim shp As Shape
UsersChoice = ""
On Error GoTo CheckBoxHandlingERROR
sCaller = Application.Caller
Set shp = ActiveSheet.Shapes(sCaller)
Set cbx = ActiveSheet.CheckBoxes(sCaller)
id = Val(Mid$(sCaller, Len("Option_") + 1, 5))
' maybe something based on Select Case?
Select Case id
Case 1:
'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of First Attribute changes, name it'"
FirstOptionLogical = Not FirstOptionLogical
'FirstOptionLogical = IIf(cbx.Value = xlOn, True, False)
'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
Case 2:
'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of Second Attribute changes, name it'"
SecondOptionLogical = Not SecondOptionLogical
'SecondOptionLogical = IIf(cbx.Value = xlOn, True, False)
'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
Case 3:
'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of Third Attribute changes, name it'"
ThirdOptionLogical = Not ThirdOptionLogical
'ThirdOptionLogical = IIf(cbx.Value = xlOn, True, False)
'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
Case 4:
If FirstOptionLogical Then
UsersChoice = UsersChoice & "- Larger description of First Attribute changes, name it " & vbCrLf
End If
If SecondOptionLogical Then
UsersChoice = UsersChoice & "- Larger description of Second Attribute changes, name it " & vbCrLf
End If
If ThirdOptionLogical Then
UsersChoice = UsersChoice & "- Larger description of Third Attribute changes, name it " & vbCrLf
End If
Ans0 = MsgBox("The following options were chosen:" & vbCrLf & UsersChoice & vbCrLf & vbCrLf & _
"You chose a checkbox with an option" & vbCrLf & "'START THE MACRO'" & vbCrLf & vbCrLf & " S H O U L D W E S T A R T T H E M A C R O ? ", vbYesNo + vbDefaultButton2 + vbQuestion)
If Ans0 = vbYes Then
'MACRO WITH PARAMETERS WE CHOSE BY CLICKING GETS STARTED...
' Delete all remaining checkboxes, if any (removing traces of the macro)
' In case of error, resume
On Error Resume Next
For Each chkbx In ActiveSheet.CheckBoxes
chkbx.Delete
Next
' Deleting all columns from G to the right
Range("G3").Select
ActiveWorkbook.Sheets(1).Range(Columns("G:G"), Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
' Resetting on Error event to default
On Error GoTo 0
' If chosen, start sub 'Larger description of First Attribute changes, name it'
If FirstOptionLogical Then Call RunFirstOptionSub ' Name of the Sub
' If chosen, start sub 'Larger description of Second Attribute changes, name it'
If SecondOptionLogical Then Call RunSecondOptionSub ' Name of the Sub
' If chosen, start sub 'Larger description of Third Second Attribute changes, name it'
If ThirdOptionLogical Then Call RunThirdOptionSub ' Name of the Sub
Else
If Ans0 = vbNo Then
End If
End If
Exit Sub
End Select
cbx.TopLeftCell.Offset(, 2).Interior.Color = IIf(cbx.Value = xlOn, vbGreen, vbRed)
'MsgBox cbx.Caption & vbCr & IIf(cbx.Value = xlOn, " is ", " is not ") & "chosen"
Exit Sub
CheckBoxHandlingERROR:
MsgBox "Something went wrong... ;-) in the Sub CheckBoxHandling", vbCritical + vbOKOnly
End Sub
Sub RunFirstOptionSub()
' CODE
End Sub
Sub RunSecondOptionSub()
' CODE
End Sub
Sub RunThirdOptionSub()
' CODE
End Sub
Sub MacroWithOptionsEndsWithoutATrace()
FirstOptionLogical = False
SecondOptionLogical = False
ThirdOptionLogical = False
' OPTIONAL: Delete all remaining checkboxes, if any (most important when testing macro)
On Error Resume Next
For Each chkbx In ActiveSheet.CheckBoxes
chkbx.Delete
Next
' Resetting on Error event to default
On Error GoTo 0
CheckBOxAdding
End Sub
Share and use as you wish, as I used other's knowledge and experience.
I am very sorry, but I haven't found any other solution to present this to you, and I also haven't found anyone else presenting something similar to this.
Updated on Dec 17th 2019:
You could also use these checkboxes even easier way: write a macro that
creates a blank worksheet somewhere After:=Sheets(Sheets.Count) , so that it now becomes the new "last sheet",
put there these checkboxes,
check/uncheck them and start the macro by clicking the lowest one of them,
delete this last worksheet, leaving no traces of macro
That way you won't have to think again about where to put temporary checkboxes...
Updated on Oct 7th 2020:
I finally assumed, it would be better to make this an answered question, since it is.
I'm trying to get my Sub to restart based on MsgBoxReults. The code I have doesn't contain any errors, but won't restart based on the users choice (hopefully, having an IF statement within another IF isn't the issue)
Please assist.
Sub ContinueWeatherList()
Dim Weather As String
'Assigning a Message Box result as a Variable for Yes/No
Dim MoreWeather As VbMsgBoxResult
Weather = InputBox("Type in the weather for " & Range("C1").End(xlDown) + 1)
If Weather = "" Then
MsgBox ("No data entered. Your response has not been recorded"), vbExclamation
Else
Range("C1").End(xlDown).Offset(1, 0).Value = Range("C1").End(xlDown) + 1
Range("A1").End(xlDown).Offset(1, 0).Value = Range("A1").End(xlDown) + 1
Range("B1").End(xlDown).Offset(1, 0).Value = Weather
Columns("A:C").EntireColumn.AutoFit
MsgBox "Thank you for entering your data " & vbNewLine & "Would you like to enter another?", vbYesNo
'Using IF statement to decide what happens for each condition
If MoreWeather = vbYes Then
''Call' command won't reinitiate Sub / *NEED TO FIX*
Call ContinueWeatherList
Else
MsgBox "Thank you for you input.", vbInformation
End If
End If
End Sub
Try the code below. You need to setup a variable to get the feedback from the VBYesNo MsgBox.
Option Explicit
Sub ContinueWeatherList()
Dim Weather As String
'Assigning a Message Box result as a Variable for Yes/No
Dim MoreWeather As Variant
' add label to restart to
ContinueWeatherList_Restart:
Weather = InputBox("Type in the weather for " & Range("C1").End(xlDown) + 1)
If Weather = "" Then
MsgBox ("No data entered. Your response has not been recorded"), vbExclamation
Else
Range("C1").End(xlDown).Offset(1, 0).Value = Range("C1").End(xlDown) + 1
Range("A1").End(xlDown).Offset(1, 0).Value = Range("A1").End(xlDown) + 1
Range("B1").End(xlDown).Offset(1, 0).Value = Weather
Columns("A:C").EntireColumn.AutoFit
MoreWeather = MsgBox("Thank you for entering your data " & vbNewLine & "Would you like to enter another?", vbYesNo)
'Using IF statement to decide what happens for each condition
If MoreWeather = vbYes Then
' use GOTo command and label to reinitiate the sub
GoTo ContinueWeatherList_Restart
Else
MsgBox "Thank you for you input.", vbInformation
End If
End If
End Sub
This moves the loop to a calling sub:
Sub EnterWeatherListItems()
Dim MoreWeather As VbMsgBoxResult
MoreWeather = vbYes
Do While MoreWeather = vbYes
Call FillWeatherList
'Assigning a Message Box result as a Variable for Yes/No
'Using IF statement to decide what happens for each condition
MoreWeather = MsgBox("Thank you for entering your data " & vbNewLine & "Would you like to enter another?", vbYesNo)
Loop
MsgBox "Thank you for you input.", vbInformation
End Sub
Sub FillWeatherList()
Dim Weather As String
Weather = InputBox("Type in the weather for " & Range("C1").End(xlDown) + 1)
If Weather = "" Then
MsgBox ("No data entered. Your response has not been recorded"), vbExclamation
Else
ActiveSheet.Range("C1").End(xlDown).Offset(1, 0).Value = ActiveSheet.Range("C1").End(xlDown) + 1
ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Value = ActiveSheet.Range("A1").End(xlDown) + 1
ActiveSheet.Range("B1").End(xlDown).Offset(1, 0).Value = Weather
Columns("A:C").EntireColumn.AutoFit
End If
End Sub
From #Shai Rado's answer but without gotos or variants
Option Explicit
Sub ContinueWeatherList()
Dim Weather As String
'Assigning a Message Box result as a Variable for Yes/No
Dim NoMoreWeather As Boolean
' Loop until user says otherwise
Do Until NoMoreWeather = vbNo
Weather = InputBox("Type in the weather for " & Range("C1").End(xlDown) + 1)
If Weather = "" Then
MsgBox ("No data entered. Your response has not been recorded"), vbExclamation
Else
Range("C1").End(xlDown).Offset(1, 0).Value = Range("C1").End(xlDown) + 1
Range("A1").End(xlDown).Offset(1, 0).Value = Range("A1").End(xlDown) + 1
Range("B1").End(xlDown).Offset(1, 0).Value = Weather
Columns("A:C").EntireColumn.AutoFit
NoMoreWeather = MsgBox("Thank you for entering your data " & vbNewLine & "Would you like to enter another?", vbYesNo)
End If
Loop
End Sub
I am trying to create a confirmation so that when the cell is blank a prompt launches. If the user clicks confirm, the cell remains blank, else the cell returns to the original value. I have the following but it is not working, I hope that someone can solve this:
Private Sub MYtest()
Dim vatcell As Range
Set vatcell = Worksheets("Invoice").Range("D11:D11")
If vatcell = "" Then
response = MsgBox("Are you sure you want to change the VAT ammount?" & Chr(10) & Chr(10) _
& "Value = " & vatcell & Chr(10) & Chr(10) _
& "Do you really want to change it?", vbYesNo + vbQuestion, "Value Already Entered")
If response = vbYes Then
vatcell = ""
Else
vatcell = vatcell
End If
End If
End Sub
Thanks in advance.
The script from Daryll, which is not working:
There are two missing pieces to your solution. First, you need to store the value of the cell before it changed. Second, you need to connect to an event that tells you when the cell contents have changed.
' This is where you store the value before it was changed
Private last_vat As Variant
' this is where you capture the value when the worksheet is first loaded
Private Sub Worksheet_Activate()
Dim vatcell As Range
Set vatcell = Range("D11")
last_vat = vatcell.Value
End Sub
' This is where you respond to a change
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vatcell As Range
Set vatcell = Range("D11")
' Make sure the cell that changed is the one you are interested in
If Target = vatcell Then
' If it changed from something to nothing
If vatcell.Value = "" And last_vat <> "" Then
response = MsgBox("Are you sure you want to clear the VAT ammount?" & Chr(10) & Chr(10) _
& "Previous Value = " & last_vat & Chr(10) & Chr(10) _
& "Do you really want to change it?", vbYesNo + vbQuestion, "Value Already Entered")
If response = vbYes Then
' Allow the change (by doing nothing)
Else
' Reject the change
vatcell = last_vat
End If
End If
' Save changes from non-blank to different non-blank value
last_vat = vatcell.Value
End If
End Sub
I believe you want to have this be an event procedure. The below checks to see if cell D11 have been changed every time the worksheet "Invoice" is changed. Please note that this must be stored on the worksheet "Invoice" in the VBE.
Private Sub Worksheet_Change(ByVal Target as Range)
Dim vatcell As Range
Set vatcell = Worksheets("Invoice").Range("D11:D11")
If Not Intersect(Target,vatcell) is Nothing Then
response = MsgBox("Are you sure you want to change the VAT ammount?" & Chr(10) & Chr(10) _
& "Value = " & vatcell & Chr(10) & Chr(10) _
& "Do you really want to change it?", vbYesNo + vbQuestion, "Value Already Entered")
End If
If response = vbYes Then
vatcell = ""
Else
vatcell = vatcell
End If
End Sub
Sub Macro9()
Dim LReturnValue As Boolean
LReturnValue = IsError(Sheets("Lookup Addition").Range("A:A").Value)
If LReturnValue = False Then
i = MsgBox("there were no errors", vbOKOnly)
Else
i = MsgBox("there were errors", vbOKOnly)
End If
End Sub
I am a little confused as to what the IsError(Customfunction()) syntax should be. how do we tell it to check every cell in the the range?
Counting errors in a range doesn't require looping (which can be very slow if the range is large) or even any VBA.
Just add this worksheet function to a cell somewhere. If you don't want the user to see this cell, you can hide the row/column/sheet.
=SUMPRODUCT(ISERROR(A:A)*(1=1))
If you still want a pop-up box for the user, your VBA will now be:
Sub CountErr()
MsgBox "There are " & ActiveSheet.Range("B1").Value & " Errors"
End Sub
Make sense?
You could simply use Evaluate and the worksheet function COUNTIF to count the # of errors:
Sub CheckRangeForErrors()
Dim errCount As Long
Dim rng As Range
Dim cl As Range
Dim col As String
col = Application.InputBox("Enter the column letter you would like to check for errors", "Column Name?")
If Not Len(col) = 1 Then
MsgBox "You have entered an invalid selection", vbCritical
Exit Sub
End If
Set rng = Sheets("Lookup Addition").Range(col & "1", Range(col & "1048576").End(xlUp))
errCount = Application.Evaluate("COUNTIF("& rng.Address &",IsError)")
If errCount = 0 Then
MsgBox "there were no errors", vbOKOnly
Else
MsgBox "there were " & errCount & " errors", vbOKOnly
End If
End Sub