I am importing a csv file which has cell references to a worksheet. The cell reference can be wrong, because the user once made an error typing the cell reference (for example: instead of "AM1" the user wrote "AMQ") or something different went wrong.
The problem is, that I have more than 1000 cell references which can change dynamically and there can be any error imaginable, as the user can write anything into it.
I am trying to write a function which checks if the reference is valide, but I can't find a solution for checking if the cell reference exists in excel.
For example, I have this code but it always gives a run time error back, because the Range(rng).Row function doesn't work if rng is not a valide input. But how do I work around it?
This as exptected always works:
Sub Test()
rng = "A1"
flag = rangeExists(rng)
debug.print flag
End Sub
This doesn't work:
Sub Test()
rng = "AQ"
flag = rangeExists(rng)
debug.print flag
End Sub
The function:
Function rangeExists(ByVal rng As String) As Boolean
Dim row_int As Integer
row_int = Range(rng).Row
On Error Resume Next
If Err.Number <> 0 Then
rangeExists = False
Else
rangeExists = True
End If
On Error GoTo -1
End Function
I am trying to find a solution with the Error Handling in VBA, but I am not able to do so. Do you have any idea how to solve this?
This will simply return True if it's a valid range, and False if it's not.
Function IsRangeValid(ByVal rng As String) As Boolean
Dim r As Range
On Error Resume Next
Set r = ActiveSheet.Range(rng)
On Error Goto 0
IsRangeValid = (Not r Is Nothing) ' parenthesis optional
End Function
Related
I am a novice in vba who currently designing some sorts of automated Matrix system in excel. I tried both sets of codes in a Worksheet and it runs perfectly. But,when i try to use the same code in an event sub in an userform, an error 91 popped out and showed an error in orivalue, though I already assign a value to it. Also I will highlight the debug lines according to the compiler.
Here are the codes for the function.
Function find_prevconfig(x2 As Integer) As Range
For y = 0 To 30
If Range("E590").Offset(y, x2) = "Y" Then
Set find_preconfig = Range("C590").Offset(y, 0)
Exit Function
End If
Next y
End Function
And here is the event sub that i called the function to:
Private Sub btn_confirm_Click()
Dim orivalue As Range
Dim i As Integer
For i = 0 To 30
If Range("E26").Offset(0, i).Value = Range("J6").Value Then
Set orivalue = find_prevconfig(i)
MsgBox (orivalue)
End If
Next i
End Sub
The debug line is MsgBox (orivalue) as it said orivalue = nothing. Your help and advices are really much appreciated!
the object variable or With block variable not set" or Error "91"
There are few things that I will address.
1. Regarding the error, you need to check if the object exists before you use it. For example
The line MsgBox (orivalue) should be written as
Set orivalue = find_prevconfig(i)
If Not orivalue Is Nothing Then
MsgBox orivalue.Value
Else
MsgBox "Object is Nothing"
End If
2. Your object find_prevconfig will always be Nothing even if the condition is True. And that is because of a typo. Function name is find_prevconfig but you are using find_preconfig. It is advisable to always use Option Explicit
3. Fully qualify your objects. In your code if you do not do that, then it will refer to the active sheet and the active sheet may not be the sheet that you are expecting it to be. For example ThisWorkbook.Sheets("Sheet1").Range("E590").Offset(y, x2)
4. Even though, .Value is the default property of a range when you are assigning a value or reading a value, it is advisable to use it explicitly. I personally believe it is a good habit. Will help you avoid lot of headaches in the future when you are quickly skimming the code. Set rng = Range("SomeRange") vs SomeValue = Range("SomeRange").Value or SomeValue = Range("SomeRange").Value2
5. When you are doing a string comparison, it is advisable to consider that the strings can have spaces or can be of different case. "y" is not equal to "Y". Similarly, "Y " is not equal to "Y". I, if required, use TRIM and UCASE for this purpose as shown in the code below.
Your code can be written as (UNTESTED)
Option Explicit
Function find_prevconfig(x2 As Long) As Range
Dim y As Long
Dim rng As Range
Dim ws As Worksheet
'~~> Change sheet as applicable
Set ws = ThisWorkbook.Sheets("Sheet1")
For y = 0 To 30
If Trim(UCase(ws.Range("E590").Offset(y, x2).Value2)) = "Y" Then
Set rng = ws.Range("C590").Offset(y)
Exit For
End If
Next y
Set find_prevconfig = rng
End Function
Private Sub btn_confirm_Click()
Dim orivalue As Range
Dim i As Long
Dim ws As Worksheet
'~~> Change sheet as applicable
'~~> You can also pass the worksheet as a parameter if the comparision is
'~~> in the same sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
For i = 0 To 30
If ws.Range("E26").Offset(0, i).Value = ws.Range("J6").Value Then
Set orivalue = find_prevconfig(i)
'~~> Msgbox in a long loop can be very annoying. Use judiciously
If Not orivalue Is Nothing Then
'MsgBox orivalue.Value
Debug.Print orivalue.Value
Else
'MsgBox "Object is Nothing"
Debug.Print "Object is Nothing"
End If
End If
Next i
End Sub
How can I resolve the type mismatch error (indicated)?
If I want to restrict the sub to the specified ranges, why would changing If Not Intersect to If Intersect exit the sub?
Private Sub Workbook_SheetBeforeDoubleClick(ByVal sH As Object, ByVal Target As Range, Cancel As Boolean)
' Exclude specified ranges
Dim rExcl(1) As Range, i As Integer, r As Range
Set rExcl(0) = Range("Table1"): Set rExcl(1) = Range("Table2")
For i = 0 To 1
For Each r In rExcl(i)
If r.Parent Is sH Then
If Not Intersect(Target, r) Is Nothing Then Exit Sub ' Type mismatch error
End If
Next
Next
End Sub
It seems that the purpose of the code posted is to validate if the user double-clicked a cell within any of the Tables (i.e.: Table1 or Table2), if so then Exit Sub.
In regards to the questions:
1. How can I resolve the type mismatch error (indicated)?
If Not Intersect(Target, r) Is Nothing Then Exit Sub ' Type mismatch error
Unfortunately, this error cannot be reproduced. This error is triggered when the data type of a variable differs to what is required. In this case it seems "almost" impossible because:
Intersect expects ranges and both variables (Target and r) are defined as ranges.
Intersect returns an object (range) which is what Is Nothing is expecting.
Intersect could also return an Error when the ranges have different parents, but that situation is already taken care by this line If r.Parent Is Sh Then.
The proposed solution includes a method to debug this error when it happens.
2. If I want to restrict the sub to the specified ranges, why would changing If Not Intersect to If Intersect exit the sub?
This is happening because the code posted is validating the ranges cell by cell, therefore if the user double-clicked the last cell of the table then the code compares the first cell and because there is no intersection the code exits the sub.
Bear in mind that the purpose is to validate if the double-clicked cell belongs or not to any of the tables ( i.e.: “ranges intersection”, if one cell intersect or not with a range, then the entire range intersects or not), as such there is no need to validate each cell, instead validate the entire range at once.
Proposed Solution:
Note that the ERR_Intersect subroutine should be just temporary, it is include to help analyze the mismatch error.
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim rExcl(1) As Range, vRng As Variant
Set rExcl(0) = Range("Table1")
Set rExcl(1) = Range("Table2")
For Each vRng In rExcl
Rem Validate Worksheet
If vRng.Parent Is Sh Then
Rem Validate Target
On Error Resume Next
If Not Intersect(Target, vRng) Is Nothing Then
blErr = Error.Number <> 0
On Error GoTo 0
If blErr Then GoTo ERR_Intersect
Exit Sub
End If
On Error GoTo 0
End If: Next
Exit Sub
ERR_Intersect:
Debug.Print vbLf; "Error: "; Err.Number; " - "; Err.Description
Debug.Print "Object"; Tab(11); "TypeName"; Tab(21); "Address"; Tab(31); "Parent"
Debug.Print "Target"; Tab(11); TypeName(Target);
Debug.Print Tab(21); Target.Address(0, 0);
Debug.Print Tab(31); Target.Parent.Name;
Debug.Print
Debug.Print "vRng"; Tab(11); TypeName(vRng);
Debug.Print Tab(21); vRng.Address(0, 0);
Debug.Print Tab(31); vRng.Parent.Name;
Debug.Print
MsgBox "Error: " & Err.Number & " - " & Err.Description & vbLf & _
vbTab & "See Immediate Window for details."
Exit Sub
End Sub
Your code works without any problem in the way you presented and it will also work in the way you try understanding, but with a different meaning, respectively:
You should understand that Intersect returns a 'Range' and the above code checks if this Range exists. In words, this part should be understood as "If the two ranges are intersecting".
This part If Intersect(Target, r) Is Nothing Then Exit Sub means "If the two ranges are not intersecting" (such an eventual intersection does not exist).
No any 'Type mismatch' should exist in both mentioned variants, if you are referring to real tables. It may appear if you named a different object (not a range) as 'TableX'...
Please, try inserting the next code line:
Debug.Print TypeOf rExcl(0) Is Range, TypeOf rExcl(1) Is Range: stop
after:
Set rExcl(0) = Range("Table1"): Set rExcl(1) = Range("Table2")
What does it return in Immediate Window?
Edited:
You could not 'reproduce the error in Debug.Print' because that line is not even reached...
There is a conflict in your workbook. There is the Workbook event you show us in the question and another Worksheet_BeforeDoubleClick event which tries closing the Excel application if the double clicked cell is the one you claim as being 'strange'...
The sheet event is triggered first and the Workbook one is not triggered anymore, since the code tries quitting Excel application. Try put Exit Sub as the first code line in the Worksheet event and try the double click again.
Nothing wrong will happen after that...
I have a formula that makes an API request every time it's executed, which makes it slow. I'd like to prevent Excel from automatically recalculating cells containing this formula but still automatically recalculate other cells.
I've tried setting calculation mode to Manual with:
Application.Calculation = xlCalculationManual
However this prevents other cells without my formula from calculating automatically.
Another idea I've had is to check if a cell has been "frozen" and then return it's current value instead of calling the API for a new value. The issue with this is that Excel doesn't provide a way to exit the function without altering the cell value.
Function MyFormula() As Variant
If CellIsFrozen() Then
MyFormula = Application.Caller.Value 'return current value
Else
MyFormula = GetNewValueFromAPI() 'expensive call to server
End If
End Function
My issue with the above is that Application.Caller.Value returns the cell value by performing a recalculation and results in an infinite recursion.
FYI - the CellIsFrozen method is just an example sub that would somehow check whether the cell was called automatically or manually.
I'm also aware of Application.Caller.Value2 and .text, unfortunately these don't help me. Value2 also causes a recalculation, and text just returns a string representation (which is not useful because it could be "######" if the value is a date and the column is too narrow).
Is there a way to interrupt Excel's recalculation process for specific formulas?
Otherwise, is it possible to extract a value of a cell without performing a recalculation - I'm guessing that Excel stores the value somewhere because it's visible on the worksheet, it makes no sense to insist on recalculating every time.
In the context my previous answer to the post involving single cell, i also want share our old experience involving multiple cells. that days We used the formula in an indexed fashion like =myformula(1)... etc and stored it in a global array. Now today thanks to your great idea of Caller function. I recreated another improvised solution involving multiple cells.
Here again in module1
Global Flag As Boolean, LastValArr(1 To 10, 1 To 2) As Variant, Ws As Worksheet, Rng As Range
Public Function MyFormula() As Variant
Dim Adr As String, X As Integer
If Flag Then
MyFormula = GetNewValueFromAPI() 'expensive call to server
Else
Adr = Application.Caller.Address
For X = 1 To 10
If InStr(1, LastValArr(X, 2), Adr) > 0 Then
MyFormula = LastValArr(X, 1)
Exit For
End If
Next
End If
End Function
Function GetNewValueFromAPI() As Variant
GetNewValueFromAPI = Application.WorksheetFunction.RandBetween(1, 1000)
End Function
Sub CalcA1()
Flag = True
Rng.Dirty
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub
Sub ToggleFlag()
Flag = Not Flag
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
If Flag Then Rng.Dirty
End Sub
in Workbook_Open event
Private Sub Workbook_Open()
Dim X As Integer
Dim Cell As Range
Set Ws = ThisWorkbook.Sheets("Sheet1")
Set Rng = Ws.Range("A1:A5")
Set Rng = Union(Rng, Ws.Range("C1:C5"))
Flag = True
Rng.Dirty
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub
in Sheet1 Worksheet_Calculate event
Private Sub Worksheet_Calculate()
Dim X As Integer
Dim Cell As Range
X = 1
For Each Cell In Rng.Cells
LastValArr(X, 1) = Cell.Value
LastValArr(X, 2) = Cell.Address
X = X + 1
Next
End Sub
Edit: On second thought after initial feel good of posting the Demo answer, I found it lacks User friendliness and ease of copy pasting UDF formulas while working in Excel Therefore i tried improvise it further so it could be used by users don't have access to VBA code and could work with copy paste of the UDF.
So 1st I came across a solution to store the Last Values in a temp sheet (may be Very Hidden Sheet). with apprehension that working with cell access may degrade performance of the code, I refrained from posting it and I finally restored to Dictionary Object.
This solution have added with basic advantage of Auto mapping of formula cells (by searching "=myformula" in used range of the Sheet) to enable/disable calculation. This would enable users without access to code modules to work freely with UDF.
Here reference to Microsoft scripting runtime has been added.
Code in module:
Global Flag As Boolean, Ws As Worksheet, Rng As Range, Dict As Dictionary
Public Function MyFormula() As Variant
Dim Adr As String
If Flag Then
MyFormula = GetNewValueFromAPI() 'expensive call to server
Else
Adr = Application.Caller.Address
'Debug.Print Adr
MyFormula = IIf(Dict.Exists(Adr), Dict(Adr), 0)
End If
End Function
Function GetNewValueFromAPI() As Variant
'Delay (2)
GetNewValueFromAPI = Application.WorksheetFunction.RandBetween(1, 1000)
End Function
Sub CalcA1()
Flag = True
If Not Rng Is Nothing Then Rng.Dirty
'Debug.Print "in calA1"
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub
Sub ToggleFlag()
Flag = Not Flag
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
If Flag And Not Rng Is Nothing Then Rng.Dirty
End Sub
Sub BuildRange()
Application.EnableEvents = False
Dim Cell As Range
CalcCnt = CalcCnt + 1
Set Rng = Nothing
Dict.RemoveAll
For Each Cell In Ws.UsedRange.Cells
If Left(Cell.Formula, 10) = "=myformula" Then
'Debug.Print "From Sht Calc -" & Cell.Address
If Dict.Exists(Cell.Address) = False Then
Dict.Add Cell.Address, Cell.Value
Else
Dict(Cell.Address) = Cell.Value
End If
If Rng Is Nothing Then
Set Rng = Cell
Else
Set Rng = Union(Rng, Cell)
End If
End If
Next
Application.EnableEvents = True
End Sub
In Workbook_Open
Private Sub Workbook_Open()
'Dim X As Integer
Dim Cell As Range
Set Ws = ThisWorkbook.Sheets("Sheet1")
Set Dict = New Dictionary
Flag = True
BuildRange
If Not Rng Is Nothing Then Rng.Dirty
Flag = False
Ws.Range("F1").Value = IIf(Flag, "On", "Off")
End Sub
In Sheet Calculate event
Private Sub Worksheet_Calculate()
BuildRange
End Sub
If you are using an UDF in the cell, I will like to make it like this workaround.
For demo and test, Only used a single cell A1 in "Sheet1" , instead of using any API, I used WorksheetFunction.RandomBetween May use range and array if multiple cells are used.
In "Sheet1" cell A1 used =myFormula()
in a module
Public Flag As Boolean, LastVal As Variant
Public Function MyFormula() As Variant
If Flag Then
MyFormula = GetNewValueFromAPI() 'expensive call to server
Else
MyFormula = LastVal
End If
End Function
Function GetNewValueFromAPI() As Variant
GetNewValueFromAPI = Application.WorksheetFunction.RandBetween(1, 1000)
End Function
Sub CalcA1 in Module1 would be used to recalculate A1 whenever necessary. It could be called from any events also according to actual requirement.
Sub CalcA1()
Flag = True
Worksheets("Sheet1").Range("A1").Dirty
Flag = False
End Sub
In workbook Open event the the LastVal was calculated with Flag as true and then Flag was reset to false to prevent further calling GetNewValueFromAPI
Private Sub Workbook_Open()
Flag = True
Worksheets("Sheet1").Range("A1").Dirty
LastVal = Worksheets("Sheet1").Range("A1").Value
Flag = False
End Sub
In Worksheet_Calculate event of Sheet1 the LastVal is being recorded.
Private Sub Worksheet_Calculate()
LastVal = Worksheets("Sheet1").Range("A1").Value
End Sub
Working Demo
Regret, I came across this post (A Real Good Question) late, since We had already been used something in this line in our workplace. Thanks to #Pawel Czyz for editing the post it came under Active List today only.
Post has been Updated below original post
I am working with two tables and want to have them connected however, the first section contains more values than the second one. I was able to work that out by adding an IfError within the Evaluate function, seen from code example (1) to (2), (using help from If Error Then Blank)
(1)
Worksheets("Sheet1").Range("Cell1").Value = Worksheets("Sheet1").Evaluate("=INDEX(data,MATCH(value,lookup_column,FALSE),column)")
(2)
Worksheets("Sheet1").Range("Cell1").Value = Worksheets("Sheet1").Evaluate("=INDEX(data,MATCH(value,lookup_column,FALSE),column), Cell2")
However, I still would like a message saying that there was an error so I tried
Sub Name()
Application.ScreenUpdating = False
On Error GoTo Msg
Worksheets("Sheet1").Range("Cell1").Value = Worksheets("Sheet1").Evaluate("=INDEX(data,MATCH(value,lookup_column,FALSE),column), Cell2")
Worksheets("Sheet1").Range("Cell1").Value = Worksheets("Sheet1").Evaluate("=INDEX(data,MATCH(value,lookup_column,FALSE),column)")
Exit Sub
Msg: MsgBox "You've had a fatal error"
End
End Sub
It did not return a message, I am assuming this is because the code for VBA was written correctly and it was the Excel function code that had an error. So is there a way to use another function to determine the excel error?
This is a sub part of a larger coding so I know it is something that can be done in excel stand alone, but this is just a minor part of the whole. Thanks in advance.
UDATE:
With comments I was able remove the Evaluate function and replace the original code with the following:
Sub SetWaterfall ()
Application.ScreenUpdating = False
Dim vMatchVal As Variant
If Not IsError(vMatchVal) Then
vMatchVal = Application.Match(Sheets("Sheet1").Range("SelectLine"), Sheets("Sheet1").Range("AS8:AS34"), 0)
Worksheets("Sheet1").Range("AW45").Value = Application.Index(Sheets("Controls").Range("AR8:AR34"), vMatchVal)
Else
Worksheets("Controls").Range("AW45").Value = "Not Data"
MsgBox "First number not found"
End If
End Sub
The issue is still that the index/match functions returns a #NA error and the message box never appears.
(Help converting Index/Match function from Excel formula to VBA code https://www.mrexcel.com/forum/excel-questions/691904-translate-index-match-function-vba-code.html)
(If this edit process is not the correct procedure for let me know and I'll close the post)
In your revised code, you have the If Not IsError test preceding the assignment to the variable you're testing for error!
Let's fix that, and try some other refactoring (for legibility's sake). If this is still not working as expected, you're going to need to provide some example data which others can use to replicate the error.
Sub SetWaterfall()
' It's not necessary to disable ScreenUpdating for this procedure...
' Application.ScreenUpdating = False
Dim theSheet as Worksheet, controls as Worksheet
Dim vMatchVal As Variant
Dim lookupVal as String
Dim matchRange as Range, indexRange as Range
Set theSheet = Sheets("Sheet1")
Set controls = Sheets("Controls")
Set matchRange = theSheet.Range("AS8:AS34")
Set indexRange = controls.Range("AR8:AR34")
lookupValue = theSheet.Range("SelectLine").Value
vMatchVal = Application.Match(lookupVal, matchRange, 0)
If Not IsError(vMatchVal) Then
theSheet.Range("AW45").Value = Application.Index(indexRange, vMatchVal)
Else
controls.Range("AW45").Value = "Not Data"
MsgBox "First number not found"
End If
End Sub
This is a basic error or lack of understanding on my part. I've searched a number of questions here and nothing seems applicable.
Here is the code
Option Explicit
Public Function ReturnedBackGroundColor(rnge As Range) As Integer
ReturnedBackGroundColor = rnge.Offset(0, 0).Interior.ColorIndex
End Function
Public Function SetBackGroundColorGreen()
ActiveCell.Offset(0, 0).Interior.ColorIndex = vbGreen
End Function
Public Function CountBackGroundColorGreen(rnge As Range) As Integer
Dim vCell As Range
CountBackGroundColorGreen = 0
For Each vCell In rnge.Cells
With vCell
If ReturnedBackGroundColor(vCell) = 14 Then
CountBackGroundColorGreen = CountBackGroundColorGreen + 1
End If
End With
Next
End Function
Public Function GetBackgroundColor() As Integer
Dim rnge As Range
GetBackgroundColor = 3
rnge = InputBox("Enter Cell to get Background color", "Get Cell Background Color")
GetBackgroundColor = ReturnedBackGroundColor(rnge)
End Function
I was adding the last function and everything else was working prior to that and am getting the error on the first statement in that function.
For the error, one of the possible fixes is to add a reference the proper library. I don't know what is the proper library to be referenced and cannot find what library the InputBox is contained. It's an activeX control but I don't see that in the tools->reference pull down. I do have microsoft forms 2.0 checked.
I've tried various set statements but I think that the only object that I've added is the inputbox.
Any suggestions?
thanks.
Use application.inputbox, add the type as range and Set the returned range object.
Option Explicit
Sub main()
Debug.Print GetBackgroundColor()
End Sub
Public Function GetBackgroundColor() As Integer
Dim rnge As Range
Set rnge = Application.InputBox(prompt:="Enter Cell to get Background color", _
Title:="Get Cell Background Color", _
Type:=8)
GetBackgroundColor = ReturnedBackGroundColor(rnge)
End Function
Public Function ReturnedBackGroundColor(rnge As Range) As Integer
ReturnedBackGroundColor = rnge.Offset(0, 0).Interior.ColorIndex
End Function