I want to update a line in my table based on a cell in another sheet, and to that end I intend to use the index match function. When I run the code below I get the error that it cannot get the property of the match function class.
What is the correct syntax in this regard?
Sub Update_Customer()
' Declarations
Dim rng as listobject
Dim wf as application.worksheetfunction
Dim cs_sht as string
Set rng = Sheets(1).ListObjects("Table_Customer")
Set ws = ThisWorkbook.ActiveSheet
cs_sht = ws.Name
' ERROR RUNNING THIS LINE vvvvv
wf.Index(rng.ListColumns("Firstname"), wf.Match(cs_sht, rng.ListColumns("Customer ID"), 0)) = ws.Range("C_Firstname").Value
End Sub
Excel functions need to be nested, because a cell's value needs to be parsed as a single step.
VBA code doesn't need to do that. VBA instructions work best and are easier to debug when you split them and make them do as little work as possible.
So instead of this:
wf.Index(rng.ListColumns("Firstname"), wf.Match(cs_sht, rng.ListColumns("Customer ID"), 0))
Split it up:
Dim matchResult As Long
matchResult = WorksheetFunction.Match(cs_sht, rng.ListColumns("Customer ID").DataBodyRange, 0)
Dim indexResult As Variant
indexResult = WorksheetFunction.Index(rng.ListColumns("FirstName").DataBodyRange, matchResult)
Note that you'll get a run-time error if either function fails to find what it's looking for. Use On Error to handle that case:
On Error GoTo CleanFail
Dim matchResult As Long
matchResult = WorksheetFunction.Match(...)
...
Exit Sub
CleanFail:
MsgBox "Could not find record for '" & cs_sht & "'." & vbNewLine & Err.Description
End Sub
Get rid of wf. There's no use to copy object references of objects that are already global. The fewer global variables you use, the better.
if the first name changes I can update the table to match the new name from my worksheet
You can't just assign the indexResult to a new value. The indexResult isn't holding a reference to any cell, it's just the result of the INDEX worksheet function. You need to use that result to get the cell you want to modify:
Dim targetCell As Range
Set targetCell = rng.ListColumns("FirstName").DataBodyRange.Cells(indexResult)
targetCell.Value = ws.Range("C_Firstname").Value
Related
I'm trying to cycle through a selection of cells and rename those cells based on text values on the spreadsheet.
Sub naming()
Dim cel As Range
Dim selectedRange As Range
Dim to_offset As Integer
Set selectedRange = Application.Selection
Answer = InputBox("Column Where Named Are?")
col_number = Range(Answer & 1).Column
For Each cel In selectedRange.Cells
cel.Name.Delete
to_offset = col_number - cel.Column
cel.Name = cel.Offset(0, to_offset).Value
Next cel
End Sub
The delete command is the problem - so I thought I'd check for names using Len() but get a 1004 error.
If there are no names already defined for the cell it works (but I can't leave the delete code in).
If there are names already defined for the cell it works (and I use the delete).
I need to use the delete for existing names - but have it step over blank names.
A quick and dirty way would be to wrap the line in question between On Error Resume Next and On Error Goto 0, so the code would look like that
On Error Resume Next 'skip line in case of an error
cel.Name.Delete
On Error GoTo 0 'reset error handling
Using On Error Resume Next tells VBA to ignore the error and continue on. There are specific occasions when this is useful. Most of the time you should avoid using it. I think this might be a case where you could use it.
Or you wrap the code in a sub
Sub deleteName(rg As Range)
On Error GoTo EH
rg.Name.Delete
Exit Sub
EH:
End Sub
and use it like that
For Each cel In selectedRange.Cells
deleteName cel
to_offset = col_number - cel.Column
cel.Name = cel.Offset(0, to_offset).Value
Next cel
But in this case this is IMHO not much of a difference.
Further reading on Error handling
A quick and direct way to delete names in selection
In addition to #Storax 'es solution you might benefit from the fact that the relatively unknown function rng.Value(xlRangeValueXMLSpreadsheet) (analyzing the entire sheet structure) returns also all existing names of a selected range as XML string. This saves further error handling.
Assign them to an array and delete them in a loop as follows:
Option Explicit ' code module header
Sub DelNamesInSelectedRange()
'a) Define selected range by any method
Dim selectedRng As Range
Set selectedRng = Application.Selection
'b) Get all names in selected range via XMLSpreadsheet analyze
Dim myNames
myNames = GetNames(selectedRng)
'c) Delete received names
Dim i As Long
For i = 1 To UBound(myNames) - 2
ThisWorkbook.Names(myNames(i)).Delete
Next
End Sub
Help function GetNames()
Applying some XML logic including namespaces via XPath search string* allows to extract all names of the specified range and to return an array of all existing names.
A sample extract of this xml might be:
<?xml version="1.0"?>
<?mso-application progid="Excel.Sheet"?>
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"
xmlns:o="urn:schemas-microsoft-com:office:office"
xmlns:x="urn:schemas-microsoft-com:office:excel"
xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
xmlns:html="http://www.w3.org/TR/REC-html40">
' <!-- ... omitting styles etc -->
' <!-- ... -->
' <Names>
' <NamedRange ss:Name="FirstName" ss:RefersTo="=Sheet1!R1C1"/>
' <NamedRange ss:Name="SecondName" ss:RefersTo="=Sheet1!R3C1"/>
' <NamedRange ss:Name="LastName" ss:RefersTo="=Sheet1!R2C3"/>
' </Names>
' <!-- ... -->
'</Workbook>
Function GetNames(rng As Range)
'[0]Get Value(11)
Dim s As String
s = rng.Value(xlRangeValueXMLSpreadsheet) ' or: rng.Value(11)
'[1]Set xml document to memory
Dim xDoc As Object: Set xDoc = CreateObject("MSXML2.DOMDocument.6.0")
'[2]Add namespaces
xDoc.SetProperty "SelectionNamespaces", _
"xmlns:ss='urn:schemas-microsoft-com:office:spreadsheet' " & _
"xmlns:ht='http://www.w3.org/TR/REC-html40'"
'[3]Get cells with Names/NamedRange/#Name
If xDoc.LoadXML(s) Then ' load wellformed string content
Dim cell As Object, cells As Object
'Set cells = xDoc.SelectNodes("//ss:Cell[ss:Data/#ss:Type='Number']") ' XPath using namespace prefixes
Set cells = xDoc.SelectNodes("//ss:Names/ss:NamedRange/#ss:Name") ' XPath using namespace prefixes
Dim tmp(): ReDim tmp(1 To cells.Length)
For Each cell In cells
Dim i As Long: i = i + 1
tmp(i) = cell.Text
Next cell
'[4]return "flat" array
GetNames = tmp
End If
End Function
I tried using Hlookup.
The code returns the following error:
“Unable to get the HLookup property of the WorksheetFunction Class”
I tried error handling but I get:
Run-time error '13' Type mismatch.
I realised it is because of conflicting data types. How do I express If myHLookupResult <> "" Then MsgBox myHLookupResult in a way it can handle looking at the long datatype.
Dim myHLookupResult As Long
On Error Resume Next
myHLookupResult = WorksheetFunction.HLookup(CalcSheet.Range("C81"), CalcSheet, 57)
On Error GoTo 0
If myHLookupResult <> "" Then MsgBox myHLookupResult
pmp.Offset(0, 14).Value = myHLookupResult
Illustrating #BigBen's comment, and reviewing your code:
Use a variant type so you can handle the returned error
Use variables to set the lookup variable and range (not required)
Define if you want an exact match or not with the last argument in the lookup function
Side note: You lookup range was set to the name of the sheet (or at least it appears)
Read code's comments and adjust it to fit your needs.
Public Sub HLookupResult()
' Not required, but nice to set the value to a variable
Dim lookupValue As Variant
lookupValue = CalcSheet.Range("C81").Value
' Not required, but nice to set the lookup range to a variable
Dim lookupRange As Range
Set lookupRange = CalcSheet.Range("A1:B5")
' Use variant so if not found can handle the error
Dim resultValue As Variant
resultValue = Application.HLookup(lookupValue, lookupRange, 2, False)
' Check the error and do something
If IsError(resultValue) Then
MsgBox "Not found"
Else
MsgBox resultValue
End If
End Sub
Ok, I realised I didn't know how to use the HLookup function and needed it to be:
myHLookupResult = WorksheetFunction.HLookup(CalcSheet.Range("C81"), CalcSheet.Range("C57:CX58"), 2)
Although I'm sure the error checking will help if any issues were to arise.
Thanks.
I got stumped by a rather weired behaviour of Excel (tested on Office Pro 2016 and Office 365).
It appears as if Name.RefersToRange breaks when referring to a non-contiguous range.
See this test procedure
Public Sub test()
Dim n As Name
With ActiveWorkbook
For Each n In .Names ' remove all preexisting names
n.Delete
Next n
Call .Names.Add("rPass", "=Sheet1!$A$1:$C$3") ' create a new contiguous named range
Call .Names.Add("rFail", "=Sheet1!$A$1,Sheet1!$C$3") ' create a new non-contigous named range
Debug.Print .Names("rPass").RefersTo ' runs fine Output: =Sheet1!$A$1:$C$3
Debug.Print .Names("rPass").RefersToRange.Address ' runs fine Output: $A$1:$C$3
Debug.Print .Names("rFail").RefersTo ' runs fine Output: =Sheet1!$A$1,Sheet1!$C$3
Debug.Print .Names("rFail").RefersToRange.Address ' crashes with Error 1004
End With
End Sub
I found a clumsy workaround like this
Public Function FunkyRefersToRange(rng As Name) As Range
Dim r As Range
Set r = Range(Mid(rng, 2)) ' create a local range by stripping the leading equal sign of the reference
Set FunkyRefersToRange = r
End Function
With that you can now write (as long the correct worksheet is selected)
Debug.Print FunkyRefersToRange(.Names("rFail")).Address
But I'd like to understand why non-contiguous ranges cannot be referenced via Name.RefersToRange and how to overcome that limitation more elegantely than shown above.
It should work like this:
Sub WhatsInaName()
Dim disJoint As Range, N As Name, addy As String
Set disJoint = Range("A1,B9")
disJoint.Name = "jim"
Set N = disJoint.Name
addy = N.RefersToRange.Address
MsgBox disJoint.Address & vbCrLf & addy
End Sub
Can you replicate my result on your computer?
Trying to write a VBA function that will return the column number given the header cell string and the worksheet name but I get the Subscript out of range error.
Here is the function:
Public Function namedColumnNo(heading As String, shtName As String) As Long
' Return the column number with named header text'
' on given worksheet.
Dim r As Range
Dim wks As Worksheet
Debug.Print shtName
'Exit Function
Set wks = Sheets(shtName)
wks.Range("1:1").Select
With wks
r = .Range("1:1").Find(heading, LookIn:=xlValue)
If r Is Nothing Then
namedColumnNo = -1
Else: namedColumnNo = r.Column
End If
End With
End Function
I am using this test sub to call the funtion:
Public Sub getCol()
Debug.Print "Find MidTemp on " & DataSht.RawDataSht
Debug.Print "Col " & namedColumnNo("MidTemp", DataSht.RawDataSht)
End Sub
I have a user defined type DataSht where I have variables to name worksheets e.g.
Public Type dataShtNames
HeaderSht As String
RawDataSht As String
ResultDataSht As String
End Type
Public DataSht As dataShtNames
With the Exit Function statement uncommented the variables resolve OK with the debug.print statements I get
Find MidTemp on RawData
RawData:MidTemp
Col 0
Leaving the function to run through the error occurs at
Set wks = Sheets(shtName)
If I replace the argument shtName with the actual sheet name as a string "RawData", then the error moves down to the line using the second argument heading. If I substitute a the parameter with a string here the error persists.
Is there something I am missing here? Some help will be much appreciated.
Sadly can't comment, but you're actually getting the out of range error because it should be LookIn:=xlValues where you have LookIn:=xlValue
As #Mathieu indicates, you'll need to fix add Set r = Find(heading, LookIn:=xlValues) to set the range to the value returned.
As a side note-you should drop the selection. Its not doing anything for you.
With wks.Range("1:1")
Set r = .Find(heading, LookIn:=xlValues)
If r Is Nothing Then
namedColumnNo = -1
Else: namedColumnNo = r.Column
End If
End With
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