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
Related
This code is for something I'm doing at work, it's outputting "No patient reference!" in a MsgBox.
If I remove the if that checks if the cell is IsEmpty I get "Patient not found" in a MsgBox.
It seems like I'm missing something and I'm not sure what, can anyone help?
Private Sub CommandButton2_Click()
Dim emptytest2 As Boolean
emptytest2 = IsEmpty(Sheet1.Range("C28").Value)
If emptytest2 = False Then
MsgBox "No patient reference!"
End
End If
Dim found As Range
Dim band1 As Range
Dim foundoff As Range
Set found = Sheet2.Columns("B").Find(what:=Sheet1.Range("C28").Value, LookIn:=xlValues, lookat:=xlWhole)
If Not found Is Nothing Then
Set band1 = Sheet1.Range("C29")
MsgBox found & " - Data found for patient in cell " & found.Address
Set foundoff = Range(found.Address).Offset(, 30)
band1.Copy
Sheet2.Range(foundoff.Address).PasteSpecial
Else
MsgBox "Patient not found"
End
End If
MsgBox "Successfully added band cutoff data to " & found
End Sub
Option Explicit
Private Sub CommandButton2_Click()
Dim ref As Range, found As Range, rng As Range
Set ref = Sheet1.Range("C28")
If Len(ref.Value) = 0 Then
MsgBox "No patient reference!", vbExclamation
Exit Sub
End If
Set found = Sheet2.Columns("B:B").Find(what:=ref.Value, _
LookIn:=xlValues, lookat:=xlWhole)
If found Is Nothing Then
MsgBox "Patient Ref '" & ref.Value & "' not found", vbExclamation
Exit Sub
Else
Set rng = found.Offset(, 30) ' col AF
rng.Value = ref.Offset(1) ' C29
MsgBox "Patient Ref: '" & ref.Value & "' found in cell " & found.Address
End If
MsgBox "Successfully added " & rng.Value & " to " & rng.Address
End Sub
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.)
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
I am very new to VBA and coding in general. I am struggling with this bit of code where I would like to copy the data in row A in sheet "System 1" and use it in my validation list. However, with this current bit of code, it seems that I am getting the row data from my current sheet and not from sheet "System 1"
What am I doing wrong here? What's the best practice when referring to other sheets to optimise the speed sheet of excel?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim range1 As Range, rng As Range
Set Sheet = Sheets("System 1")
Set range1 = Sheets("System 1").Range("A1:BB1")
Set rng = Range("M2")
With rng.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & Name & "'!" & .range1.Address
End With
This code should give you a good start. Fix and adjust to your needs. Study the customize sections of the code carefully. The WSChange should work perfectly except maybe there is something weird about those public variables (you can always put them into the procedure ... and the events are ... I don't get them, but I will soon enough.
You cannot use a range from a different worksheet to use it as a validation range (similar to conditional formatting, that is for Excel 2003), so you have to define a name to use as a range.
This one goes into a module. I just couldn't see it in the worksheet:
Option Explicit
Public strMain As String
Public Const cStrValList As String = "ValList" 'Validation List Name
Sub WSChange()
'-- Customize BEGIN --------------------
'Name of the main worksheet containing the validation RANGE.
'*** The worksheet should be defined by name so that this script can be run ***
'*** from other worksheets (Do NOT use the Activesheet, if not necessary). *** ***
Const cStrMain As String = "Main" 'If "" then Activesheet is used.
'Name of the worksheet containing the validation LIST.
Const cStrSys As String = "System 1"
'*** The next two constants should be defined as first cell ranges, so when ***
'*** adding new data, the last cell could be calculated again and the data *** ***
'*** wouldn't be 'out of bounds' (outside the range(s)).
'Validation RANGE Address. Can be range or first cell range address.
Const cStrMainRng As String = "$M$2" 'orig. "$M$2"
'Validation LIST Range Address. Can be range or first cell range address.
Const cStrSysRng As String = "$A$1" 'orig. "$A$1:$BB$1"
'-- Customize END ----------------------
strMain = cStrMain
Dim oWsMain As Worksheet
Dim oRngMain As Range
Dim oWsSys As Worksheet
Dim oRngSys As Range
Dim oName As Name
Dim strMainRng As String
Dim strMainLast As String
Dim strSysRng As String
Dim strSysLast As String
'---------------------------------------
On Error GoTo ErrorHandler 'No error handling so far!
'---------------------------------------
'Main Worksheet
If cStrMain <> "" Then 'When cStrMain is used as the worksheet name.
Set oWsMain = ThisWorkbook.Worksheets(cStrMain)
Else 'cStrMain = "", When ActiveSheet is used instead. Not recommended.
Set oWsMain = ThisWorkbook.ActiveSheet
End If
With oWsMain
If .Range(cStrMainRng).Cells.Count <> 1 Then
strMainRng = cStrMainRng
Else
'Calculate Validation Range Last Cell Address
strMainLast = .Range(Cells(Rows.Count, _
.Range(cStrMainRng).Column).Address).End(xlUp).Address
'Calculate Validation Range and assign to a range variable
strMainRng = cStrMainRng & ":" & strMainLast 'First:Last
End If
Set oRngMain = .Range(strMainRng) 'Validation Range
End With
'---------------------------------------
'System Worksheet
Set oWsSys = Worksheets(cStrSys) 'Worksheet with Validation List
With oWsSys
If .Range(cStrSysRng).Cells.Count <> 1 Then
strSysRng = cStrSysRng
Else
'Calculate Validation Range Last Cell Address
strSysLast = .Range(Cells(.Range(cStrSysRng).Row, _
Columns.Count).Address).End(xlToLeft).Address
'Calculate Validation Range and assign to a range variable
strSysRng = cStrSysRng & ":" & strSysLast 'First:Last
End If
Set oRngSys = .Range(strSysRng) 'Validation List Range
End With
'---------------------------------------
'Name
For Each oName In ThisWorkbook.Names
If oName.Name = cStrValList Then
oName.Delete
Exit For 'If found, Immediately leave the For Each Next loop.
End If
Next
ThisWorkbook.Names.Add Name:=cStrValList, RefersTo:="='" & cStrSys _
& "'!" & strSysRng
With oRngMain.Validation
.Delete 'delete previous validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=" & cStrValList
End With
'---------------------------------------
ProcedureExit:
Set oRngMain = Nothing
Set oRngSys = Nothing
Set oWsSys = Nothing
Set oWsMain = Nothing
Exit Sub
'---------------------------------------
ErrorHandler:
'Handle Errors!
MsgBox "An error has occurred.", vbInformation
GoTo ProcedureExit
'---------------------------------------
End Sub
And some 'eventing', not so good, but I've run out of patience.
This actually goes into the 'System 1' worksheet. You should maybe figure out something like that for the 'main' sheet.
Option Explicit
Public PreviousTarget As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
'MsgBox Target.Cells.Count
'-- Customize BEGIN --------------------
Const cStr1 = "Validation List Change"
Const cStr2 = "Values have changed"
Const cStr3 = "Previous Value"
Const cStr4 = "Current Value"
'-- Customize END ----------------------
Dim str1 As String
'Values in the NAMED RANGE (cStrValList)
'Only if a cell in the named range has been 'addressed' i.e. a cell is
'selected and you start typing or you click in the fomula bar, and then
'enter is pressed, this will run which still doesn't mean the value has
'been changed i.e. the same value has been written again... If the escape
'key is used it doesn't run.
If Not Intersect(Target, Range(cStrValList)) Is Nothing Then
If Target.Cells.Count > 1 Then
WSChange
MsgBox "Cannot handle multiple cells, yet."
Else
'Check if the value has changed.
If PreviousTarget <> Target.Value Then 'The value has changed.
WSChange
str1 = cStr1 & vbCrLf & vbCrLf & cStr2 & ":" & vbCrLf & vbCrLf & "'" & _
Target.Address & "' " & cStr3 & " = '"
str1 = str1 & PreviousTarget & "'" & vbCrLf & "'" & Target.Address
str1 = str1 & "' " & cStr4 & " = '" & Target.Value & "'."
MsgBox str1, vbInformation
Else 'The value has not changed.
End If
End If
Else 'The cell range is out of bounds.
End If
'Values in the NAMED RANGE ROW outside the NAMED RANGE (cStrValList9
Dim strOutside As String
'Here comes some bad coding.
strOutside = Range(cStrValList).Address
strOutside = Split(strOutside, ":")(1)
strOutside = Range(strOutside).Offset(0, 1).Address
strOutside = strOutside & ":" _
& Cells(Range(strOutside).Row, Columns.Count).Address
If Not Intersect(Target, Range(strOutside)) Is Nothing Then
If Target.Cells.Count > 1 Then
WSChange
MsgBox "Cannot handle multiple cells, yet."
Else
If PreviousTarget <> Target.Value Then 'The value has changed.
If strMain <> "" Then
WSChange
Else
MsgBox "You have to define a worksheet by name under 'cStrMain'."
End If
End If
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This gets the 'previous' Target value. This is gold concerning the speed of
'execution. It's a MUST REMEMBER.
PreviousTarget = Target.Value
End Sub
Sub vallister()
MsgBox Range(cStrValList).Address
End Sub
Sub sdaf()
End Sub
When we open this workbook, this code will look through a range and find cells that contain the text "RCA Pending" and will popup a MsgBox letting the user know which row in that column contains the specific text. The problem is, if there are multiple rows containing this text, there will also be multiple MsgBox popups.
Private Sub Auto_Open()
Dim i As Variant
Dim FindRange As Range
Set FindRange = Range("AB2:AB2000")
For Each i In FindRange
If i = "RCA Pending" Then
MsgBox "Found 'RCA Pending' in cell" & " " & i.Address, vbExclamation, "Attention"
End If
Next i
End Sub
What needs to be changed in this code so that there is only one popup that lists all the rows where "RCA Pending" was found?
Try this code:
Private Sub Auto_Open()
Dim i As Variant
Dim FindRange As Range
Dim Msg As String
Set FindRange = Range("AB2:AB2000")
For Each i In FindRange
If i = "RCA Pending" Then
If Msg = "" Then
Msg = "Found 'RCA Pending' in cell" & " " & i.Address
Else
Msg = Msg & Chr(10) & "Found 'RCA Pending' in cell" & " " & i.Address
End If
End If
Next i
If Msg <> "" Then MsgBox Msg, vbExclamation, "Attention"
End Sub
Try this,
Sub Msgbox_It()
Dim sh As Worksheet
Dim LstRw As Long
Dim i As Range
Dim FindRange As Range
Dim Msg As String
Set sh = Sheets("Sheet1") 'name of worksheet
With sh
LstRw = .Cells(.Rows.Count, "AB").End(xlUp).Row
Set FindRange = .Range("AB2:AB" & LstRw)
For Each i In FindRange
If i = "RCA Pending" Then
Msg = Msg & i.Address & vbNewLine
End If
Next i
MsgBox "Found 'RCA Pending' in cell" & " " & Msg, vbExclamation, "Attention"
End With
End Sub