I am having trouble running a VLookup inside a Change Event sub. I have tested all other lines of code and made sure they work, so it's only the VLookup that's not working.
For brief background, I have two sheets. Sheet1 contains the ID (where it could have multiple IDs on separate line, hence the SPLIT function used below), Sheet 2 contains the ID and its Description. What I wanted to do is perform a VLookup upon value change and insert description for each ID as comment into the cell.
The line that is not working for me is: Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False).
I'm not getting any errors but it jumps right to exitHandler without running the reminder of the logic. I'm certain that the ID exists in the table for the VLookup. If someone can help me point out why it is not working, I will be very appreciated!
Below is a snippet of the code where VLookup is used:
With Target
If .Comment Is Nothing Then
'do nothing
Else
.Comment.Delete
End If
If Target.Value = "" Then
.Comment.Delete
Else
If InStr(Target.Value, vbCrLf) = 0 Then
IDs = Split(Target.Value)
Else
IDs = Split(Target.Value, vbCrLf)
End If
For i = LBound(IDs) To UBound(IDs)
If commentText = "" Then
'Add description for ID as comment
commentText = Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False)
Else
'Keep on adding description for each ID as comment
commentText = commentText & vbCrLf & Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False)
End If
Next
.AddComment Text:=commentText
.Comment.Shape.TextFrame.AutoSize = True
End If
End With
exitHandler:
Application.EnableEvents = True
End Sub
As the part of the varible defintions is missing, i would guess that commentText is defined as String. If Vlookup performs a search without a match it will return an error, so the variable has to be defined as Variant otherwise you will get a type mismatch. You wont see the error when you use an On Error Goto-Statement. Also then you should check after a Vlookup if no error occured, i.e with the IsError-Function.
Thank you so much for your replies. Indeed, it should be Application.VLookup and not Application.WorksheetFunction.VLookup. I also had to convert IDs(I) to CLng to prevent 2042 error. Changing commentText to Variant is also needed to see the error code.
In the end, this is what worked for me:
Application.VLookup(CLng(IDs(i)), Sheet2.Range("A3:B30"), 2, False)
Thanks again for all the help!
Related
VBA Code to transfer value of one cell to another worksheet
Sub Button4_Click()
Dim Description As String
Worksheets("Job Order Format").Select
Description = Range("C20")
Worksheets("Job Order Record").Select
Worksheets("Job Order Record").Range("E5").Select
If Worksheets("Job Order Record").Range("E5").Offset(1, 0) <> "" Then
Worksheets("Job Order Record").Range("E5").End(x1Down).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Description
Worksheets("Job Order Format").Select
Worksheets("Job Order Format").Range("C20").Select
End Sub
The code works for the 1st attempt with no error but for the 2nd attempt I get an error of Run-time Error 1004.
First of all you have to read this article carefully.
The reason because your error is raised only on the 2nd run is because:
On the first run, you have an empty range Worksheets("Job Order
Record").Range("E5").Offset(1, 0);
That range is filled with ActiveCell.Value = Description line;
On the second run, you match the If condition and try to perform the line Worksheets("Job Order
Record").Range("E5").End(x1Down).Select;
You get an error.
So what do you need to do? The solution is very easy:
In your editor, go to Tools → Options → tick the "Require Variable Declaration":
Then go to Debug → Compile VBAProject:
You see the reason of error at once - it is misprint of direction .End(*x1Down*) variable (you have number 1 instead of l letter):
As far as you have the "Require Variable Declaration" switched off -compiler doesn't check the code before run, but when code reaches the line with error - it can't understand what to do and throws an exception.
The other thing is that if you do read the article - you would likely replace 12 lines of your code with only 6, a bit faster code, something like this:
Sub Button4_Click()
Dim Description As String
Dim OrderFormatSht As Worksheet, OrderRecordSht As Worksheet
Set OrderFormatSht = ThisWorkbook.Sheets("Job Order Format")
Set OrderRecordSht = ThisWorkbook.Sheets("Job Order Record")
Description = OrderFormatSht.Range("C20")
If Not Description = "" Then OrderRecordSht.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Description
End Sub
I keep having an issue with some code in VBA Excel was looking for some help!
I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.
So far my code is:
Sub main()
Dim cName As New Collection
For Each celli In Columns(3).Cells
Sheets(2).Activate
On Error GoTo raa
If Not celli.Value = Empty Then
cName.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
Sheets(3).Activate
Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
Resume Next
End Sub
When I try to run the code it crashes Excel, and does not give any error codes.
Some things I've tried to fix the issue:
Shorted List of Items
Converted phone numbers to string using cstr()
Adjusted Range and offsets
I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!
Updated:
Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(3).Cells
On Error GoTo raa
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
Resume Next
End Sub
Update2:
Used hold.Exists along with an ElseIf to remove the GoTo's. Also changed it to copy and paste the row to the next sheet.
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(2).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub
When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).
When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean.
The short answer to your question, now that I have the context out of the way, is that you can first check (if Not hold.exists(CStr(celli.Value)) Then) and then add if it does not already exist.
(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:
Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
tResult = True
On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
RangeExists = tResult
End Function
I am using the following code in which if there is data in the parameter - arrRecords then print the data, if there is not data in the parameter arrRecords i.e. arrRecords = "", then skip this step and get out.
If IsEmpty(arrRecords) = True Then
GoTo Get_Out
ElseIf IsEmpty(arrRecords) = Fales Then
PrintArray arrRecords, Y, Lastrecord, 1
End If
Get_Out:
I am also clearing the data in arrRecords after every loop using arrRecords = "". Still in cases where there is data or no data, the code always goes to the statement for Print. Can anyone please help me here.
From a general point of view
If you have something after the Then on the same line you have terminate the If. You will then get a syntax error if you have a following ElseIf.
Use Option Explicit to pick up typos such as Fales.
You don't need = True just If IsEmpty(arrRecords) .
You can default into an Else if not True without a test for False
Do you need to then Exit Sub if False or carry on ?
What is arrRecords? Where is it coming from?
Code:
Option Explicit
Sub test()
If IsEmpty(arrRecords) Then '<> vbNullString ''if string
GoTo Get_Out
Else
PrintArray arrRecords, Y, Lastrecord, 1
'Exit Sub '<== What happens here? Otherwise you still hit Get_Out
End If
Get_Out:
End Sub
Sub Sales_Summary_Macro()
Dim strMake, strModel, strCount As String
Dim makeLoc, modelLoc, countLoc As Integer
strMake = Application.InputBox("Make")
strModel = Application.InputBox("Model")
strCount = Application.InputBox("Count")
If strMake <> False Then
Debug.Print strMake
Debug.Print strModel
Debug.Print strCount
makeLoc = WorksheetFunction.Match(strMake, Range("A1:A10"), 0)
Debug.Print makeLoc
End If
End Sub
I just want to take the string input of the user on three different variables and find the column that contains each variable. I have tried Application.Match() and Match() alone and neither seem to work.
Not going full technical and will not post code. However, three things:
One, make sure your ranges are always fully qualified. For example, Range("A1:A10") is not nearly enough. You should specify on which sheet this should be located. If you are calling this macro from another sheet, it will give you a wrong result or throw an error.
Two, without going to too much details:
Application.Match returns an error value if there's no match found. This can be handled using IsError, which is what simoco did in his answer.
WorksheetFunction.Match throws a 1004 error when it doesn't find an error. This is not the same as returning a value. As such, this is (slightly) harder to handle.
Best practice is to always use the first one.
Three, the immediate window in VBE is your best friend. A simple ?Application.Match("FindMe", [A1:A10], 0) in the window can help you check if your formula is netting a similarly intended result.
As shown in the screenshot above, no string is found and an error value is returned.
Hope this helps!
UPD:
Is it possible to get it to return the cell reference like C1 and then use that cell reference in other functions
Sub Sales_Summary_Macro()
Dim strMake As String, strModel As String, strCount As String
Dim makeLoc, modelLoc As Integer, countLoc As Integer
Dim res As Range
strMake = Application.InputBox("Make")
strModel = Application.InputBox("Model")
strCount = Application.InputBox("Count")
If strMake <> "False" Then
Debug.Print strMake
Debug.Print strModel
Debug.Print strCount
On Error Resume Next
'Set res = Range("A1:Z1").Find(What:=strMake, LookAt:=xlWhole, MatchCase:=False)
Set res = Application.Index(Range("A1:A10"), Application.Match(strMake, Range("A1:A10"), 0))
On Error GoTo 0
If res Is Nothing Then
MsgBox "Nothing found!"
Exit Sub
End If
'Print address of result
Debug.Print res.Address
makeLoc = res.Value
Debug.Print makeLoc
End If
End Sub
BTW,
when you are using Dim strMake, strModel, strCount As String, only strCount has type String, but strMake, strModel are Variant.
The same thing with Dim makeLoc, modelLoc, countLoc As Integer - only countLoc has Integer type.
This is not a direct answer to the OP, but people (like me) may find this question helpful when trying to TRAP an error with vba Match. Typically I would use this to test if a value exists in an array.
It's quite maddening when using Application.Worksheetfunction.Match and being unable to capture a True with IsError when a value doesn't exist. Even the WorksheetFunction error handlers (iserr, isNA, etc) will not capture this as True and instead throws the VBA error of 1004 Unable to get the Match Property.
This is resolved by using Application.Match instead of Application.WorksheetFunction.Match. This is most counterintuitive as Match doesn't appear in the intellisense after typing Application. nor does Application.Match( display prompts for what fields to enter.
Meanwhile using Application.WorksheetFunction.Match does auto-populate with prompts which understandably can inspire users to take this approach and then be confused why they can't successfully trap an error.
I have a dynamically defined named range in my excel ss that grabs data out of a table based on a start date and an end date like this
=OFFSET(Time!$A$1,IFERROR(MATCH(Date_Range_Start,AllDates,0)-1,MATCH(Date_Range_Start,AllDates)),1,MATCH(Date_Range_End,AllDates)-IFERROR(MATCH(Date_Range_Start,AllDates,0)-1,MATCH(Date_Range_Start,AllDates)),4)
But if the date range has no data in the table, the range doesn't exists (or something, idk). How can I write code in VBA to test if this range exists or not?
I have tried something like
If Not Range("DateRangeData") Is Nothing Then
but I get "Runtime error 1004, method 'Range' of object '_Global' failed."
Here is a function I knocked up to return whether a named range exists. It might help you out.
Function RangeExists(R As String) As Boolean
Dim Test As Range
On Error Resume Next
Set Test = ActiveSheet.Range(R)
RangeExists = Err.Number = 0
End Function
You can replicate the match in your VBA to count before using the range how many rows you would have, or you can use error handling:
On Error Resume Next
Debug.Print range("DateRangeData").Rows.Count
If Err = 1004 Then
MsgBox "Range Empty"
Exit Sub
Else
MsgBox "Range full"
End If
Err.Clear
On Error GoTo 0
This is another approach. It has the advantage to take the container and the name you want to test. That means you can test either Sheets Names or Workbook Names for example.
Like this:
If NamedRangeExists(ActiveSheet.Names, "Date") Then
...
Else
...
End If
or
If NamedRangeExists(ActiveWorkbook.Names, "Date") Then
...
Else
...
End If
Public Function NamedRangeExists(ByRef Container As Object, item As String) As Boolean
Dim obj As Object
Dim value As Variant
On Error GoTo NamedRangeExistsError:
value = Container(item)
If Not InStr(1, CStr(value), "#REF!") > 0 Then
NamedRangeExists = True
End If
Exit Function
Exit Function
NamedRangeExistsError:
NamedRangeExists = False
End Function
Depending on the application you're doing, it's good to consider using a Dictionary. They're especially useful when you wanna check whether something exists.
Take this example:
Dim dictNames as Scripting.Dictionary
Sub CheckRangeWithDictionary()
Dim nm As Name
'Initially, check whether names dictionary has already been created
If Not dictNames Is Nothing Then
'if so, dictNames is set to nothing
Set dictNames = Nothing
End If
'Set to new dictionary and set compare mode to text
Set dictNames = New Scripting.Dictionary
dictNames.CompareMode = TextCompare
'For each Named Range
For Each nm In ThisWorkbook.Names
'Check if it refers to an existing cell (bad references point to "#REF!" errors)
If Not (Strings.Right(nm.RefersTo, 5) = "#REF!") Then
'Only in that case, create a Dictionary entry
'The key will be the name of the range and the item will be the address, worksheet included
dictNames(nm.Name) = nm.RefersTo
End If
Next
'You now have a dictionary of valid named ranges that can be checked
End Sub
Within your main procedure, all you need to do is do an existence check before using the range
Sub CopyRange_MyRange()
CheckRangeWithDictionary
If dictNames.exists("MyRange") then
Sheets(1).Range("MyRange").Copy
end if
End Sub
While loading the dictionary may look a little longer, it's extremely fast to process and search. It also becomes much simpler to check whether any named range referring to a valid address exists, without using error handlers in this simple application.
Please note that when using names at sheet level rather than workbook level, it is necessary to use more elaborate keys to guarantee uniqueness. From the way the dictionary was created, if a key is repeated, the item value is overwritten. That can be avoided by using the same Exists method as a check in the key creation statement. If you need a good reference on how to use dictionaries, use this one.
Good luck!
This is an old post, but none of the rated answers has a dynamic solution to test if a name exists in a workbook or worksheet. This function below will accomplish that:
Function pg_Any_Name(thename As String) As Boolean
Dim n As Name, t As String
For Each n In ThisWorkbook.Names
t = Mid(n.Name, InStr(1, n.Name, "!", vbTextCompare) + 1, 999)
If UCase(thename) = UCase(t) Then
pg_Any_Name = True
Exit Function
End If
Next n
End Function
Worth noting that this would not have worked for this specific question because OP had a dynamic defined range. This question would have been more accurately titled Test if Name is a Valid Range because the name always existed as a formula, the issue was if it was a valid RANGE. To address this question with a solution that checks both workbook and sheets... this function would work:
Function PG_Range_Name(thename As String) As Boolean
Dim n As Name, t As String
For Each n In ThisWorkbook.Names
t = Mid(n.Name, InStr(1, n.Name, "!", vbTextCompare) + 1, 999)
If UCase(thename) = UCase(t) Then
On Error Resume Next
PG_Range_Name = n.RefersToRange.Columns.Count > 0
Exit Function
End If
Next n
End Function