Get defined name in excel worksheet from passing range - excel

I'm trying to populate an excel file using defined names. What I like to do now is that once I move to a cell e.g. Worksheet1!$A$8, I want to retrieve the defined name for that cell which tells me what is the data needed. Right now this is what I got and only give me ....$A$8, what I expect is PROD_CATEGORY as this is what I defined the name to be for that cell. Really appreciate if anyone can help.
WorkSheet.Range[ColNumToAlpha(CurrCol)+IntToStr(HRow)].Name
thanks,

Here's a function that will return all the range names containing the range you pass to the function. You could, for instance, pass WorkSheet.Range[ColNumToAlpha(CurrCol)+IntToStr(HRow)] to this function.
Function TellNamedRanges(ByVal Target As Range) As String
Dim NamedRange As Name
Dim FoundOne As Boolean
Dim RangesFound As String
FoundOne = False
RangesFound = "Found these ranges: "
For Each NamedRange In ThisWorkbook.Names
If Not Application.Intersect(Target, Range(NamedRange.RefersTo)) Is Nothing Then
FoundOne = True
RangesFound = RangesFound & NamedRange.Name & " "
End If
Next NamedRange
If FoundOne = False Then
TellNamedRanges = RangesFound & "none found"
Else
TellNamedRanges = RangesFound
End If
End Function

Related

Excel persistent evaluate if condition is met

I am trying to evaluate an expression only if a certain condition is met. The reason I am doing this is to allow the user to "lock" a value so that changes to other variables in the formula have no effect anymore.
I tried using the function below which works great until I close the sheet and open it again.
I already tried to use an additional cell passed as parameter to copy the value to it when it's not locked and copy it back if so however excel does not allow other cell modifications within a function.
Is there any way to achieve this functionality?
Function EvaluateIf(expression As String, condition As Boolean) As Variant
Application.Volatile
Dim myText As String
Dim myVal As Variant
If condition Then
myVal = Application.Evaluate(expression)
Else
myText = Application.Caller.Text
If IsNumeric(myText) Then
myVal = Val(myText)
Else
myVal = myText
End If
End If
EvaluateIf = myVal
End Function
EDIT1:
I need to apply this function onto multiple cells so I cannot hard code the cells
EDIT2:
I currently call the function like this in excel:
=EvaluateIf(N$7*IF(ISBLANK(P$7);1;P$7)*IF(ISBLANK(R$7);1;R$7);NOT(V$7))
Try this out - normal cautions apply to using this method to skirt around the restrictions applied to the use of UDF when called from a worksheet.
Function EvaluateIf(expression, condition As Boolean, backup As Range) As Variant
Dim myText As String
Dim myVal As Variant
Dim bak
bak = backup.Value
If condition Then
myVal = expression
If myVal <> bak Then 'update cached value?
Application.Evaluate "SetBackup(""" & backup.Parent.Name & """,""" & _
backup.Address & """,""" & myVal & """)"
End If
Else
myVal = bak
End If
EvaluateIf = myVal
End Function
Sub SetBackup(ws As String, addr As String, v)
Application.Calculation = xlCalculationManual 'avoid infinite loop!
ThisWorkbook.Sheets(ws).Range(addr).Value = v
Application.Calculation = xlCalculationAutomatic
End Sub

Run time error '1004' Application defined or object defined error on Vlookup function

I am trying to utilize Vlookup function, according to the Textbox1 value user put in in Userform Guntest, automatically looking for corresponding features of the gun.
However the program currently doesn't run as it reminds me
'Runtime error '1004', method 'Range of object' _Global' failed.
The error appears on Retrieve1=…
I will be appreciated if you could help me to check where the problem is as I have really limited knowledge and experience on using VBA.
Thanks in advance.
It looks like some objects is undefined but I can't figure out where.
The module 1 code is:
Public Guncode As String
Option Explicit
Sub Test()
Call Vlookup
End Sub
Sub Vlookup()
Dim Retrieve1 As String
Dim Retrieve2 As String
Dim FinalRow As Long
Dim FinalColumn As Long
Dim WholeRange As String
If GunTest.TextBox1 = "" Then
Exit Sub
If GunTest.TextBox1 <> "" Then
MsgBox Guncode
End If
End If
With Sheets(1)
FinalRow = Range("A65536").End(xlUp).Row
FinalColumn = Range("IV1").End(xlToLeft).Column
WholeRange = "A2:" & CStr(FinalColumn) & CStr(FinalRow)
Retrieve1 = Application.WorksheetFunction.Vlookup(Trim(Guncode), Range(WholeRange), 1, False) 'Locate specific tool according to QR code number
Retrieve2 = Application.WorksheetFunction.Vlookup(Trim(Guncode), Range(WholeRange), 5, False) 'Locate specific gun type according to QR code number
If Guncode = "" Then
MsgBox "This gun doesn't exist in database!"
Else
MsgBox "The tool number is:" & Retrieve1 & vbCrLf & "The gun type is:" & Retrieve2
End If
End With
End Sub
The userform code is:
Option Explicit
Private Sub Label1_Click()
End Sub
Private Sub CommandButton1_Click()
If TextBox1 = "" Then Exit Sub 'Set condition 1 of exiting the program
Guncode = GunTest.TextBox1
With Me
Call Module1.Test
End With
End Sub
Private Sub PartID_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Click()
End Sub
It should run properly but it doesn't. Any help would be appreciated, thanks!
First off, you were passing in a number as the column letter value. CSTR() doesnt magically transform it into the letter equivalent but I like your enthusiasm.
Second, your method will bomb if the value isnt found - so you'll need to write your own error handling for it.
Sub Vlookup()
Dim Retrieve1 As String
Dim Retrieve2 As String
Dim FinalRow As Long
Dim FinalColumn As Long
Dim WholeRange As String
Dim vArr
Dim col_Letter As String
If GunTest.TextBox1 = "" Then
Exit Sub
If GunTest.TextBox1 <> "" Then
MsgBox Guncode
End If
End If
With ThisWorkbook.Sheets("Sheet1")
FinalRow = .Range("A65536").End(xlUp).Row
FinalColumn = .Range("IV1").End(xlToLeft).Column
vArr = Split(Cells(1, FinalColumn).Address(True, False), "$")
col_Letter = vArr(0)
WholeRange = "A2:" & col_Letter & CStr(FinalRow) '<---- you were passing a number in as the column value
Retrieve1 = Application.WorksheetFunction.Vlookup(Trim(Guncode), .Range(WholeRange), 1, False) 'Locate specific tool according to QR code number
Retrieve2 = Application.WorksheetFunction.Vlookup(Trim(Guncode), .Range(WholeRange), 5, False) 'Locate specific gun type according to QR code number
If Guncode = "" Then
MsgBox "This gun doesn't exist in database!"
Else
MsgBox "The tool number is:" & Retrieve1 & vbCrLf & "The gun type is:" & Retrieve2
End If
End With
End Sub
1. I am not sure what is the reason using Address(True, False) for row number.
This comes from a combination of these two functions. The true/false setting is telling the funciton to use/not use absolute references in the address.
Split ( expression [,delimiter] [,limit] [,compare] )
https://www.techonthenet.com/excel/formulas/split.php
expression.Address (RowAbsolute, ColumnAbsolute, ReferenceStyle, External, RelativeTo)
https://learn.microsoft.com/en-us/office/vba/api/excel.range.address
Shouldn't Cell (1, FinalColumn) stands for the column number?
No, the cells fucntiosn basically returns an intersection/address of rows & column.
Try this for example: debug.Print; thisworkbook.Sheets("Sheet1").Cells(2,2)
You mentioned CSTR doesn't magically transform to letter equivalent so what would it transform to? Could you further elaborate?
This is a data type conversion function. CSTR(666) essentially does this: this 666 becomes this "666"
2. vArr(0). I am confused with what does the parameter 0 stands for in the bracket. Actually this is a general question I always have regarding to parameter specification.
This is an array position refence. The split function returns an array of strings. Since we're using to capture the column label value, we only need to reference the first position.
(3) I tried copy your code and run it but still reminds me error on the same row.
Works fine for me unless there is no returning value, which returns an error which is what I meant by "bomb."

VBA COUNTA Userform

I have a Userform with several textboxes and a command button. When the information is entered and submitted the information is transfered to the first empty row.
I need a code that would counta() text within 4 columns within that row. So translate =IF(IsBlank($A2),"",COUNTA(E2:H2) to VBA code to calculate after the user submitted the information.
Option Explicit
Sub test()
Debug.Print "Var 1 : "; CountRangeIf("not(A3="""")", Range("E3:H3"))
Dim testCriteria As Boolean
testCriteria = Not (Range("A3").Value = "")
Debug.Print "Var 2 : "; CountRangeIf_Var2(testCriteria, Range("E3:H3"))
End Sub
Public Function CountRangeIf(IfCriteriaString As String, CountRange As Range) As Variant
Dim resultCriteria As Boolean
CountRangeIf = "" ' Result = "" if Criteria is false
resultCriteria = Evaluate(IfCriteriaString)
With Application.WorksheetFunction
If resultCriteria Then
CountRangeIf = .CountA(CountRange)
End If
End With
End Function
Public Function CountRangeIf_Var2(IfCriteria As Boolean, CountRange As Range) As Variant
CountRangeIf_Var2 = "" ' Result = "" if Criteria is false
With Application.WorksheetFunction
If IfCriteria Then
CountRangeIf_Var2 = .CountA(CountRange)
End If
End With
End Function
Presuming we're using Sheet1
and presuming your Row # is already stored in
ThisRowNum variable
Following should be close to what you asked for
If Trim(CStr(Sheets("Sheet1").Range("A" & ThisRowNum).Value)) = "" then
xCtr = 0 ' Your formula used a null string - you can fix this
else
xCtr = WorksheetFunction.CountA(Sheets("Sheet1").Range("E" & ThisRowNum &":H" & ThisRowNum))
endif
The xCtr variable is the result

VBA Subscript out of range, name resolution problem?

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

vlookup error (Unable to get vlookup property of the worksheetfunction class)

I have an error on the vlookup, the error says 'Unable to get vlookup property of the worksheetfunction class'
this is my code:
Private Sub Yes_Click()
Dim input_value As Variant
Dim rg As Range
Set rg = Sheet2.Range("B8:C17")
msg = InputBox("What is your name?")
If msg = WorksheetFunction.VLookup(msg, rg, 2) Then
Yes.Value = True
Else
MsgBox ("Name already in database.")
Yes.Value = False
End If
End Sub
There is no error if the name i keyed in is already in the database. however, there is an error when the name
Don’t use that function. I’m VBA there’s a method ‘Find’ for that
Dim findmsg as Range
Dim rg As Range
Set rg = Sheets("Sheet2").Range("B8:C17")
msg = InputBox(“What is your name?”)
Set findmsg = rg.find(msg)
If not findmsg is nothing then 'This condition means the names is on the database
MsgBox(“Name already exists in database”)
Yes.value=false
Else
Yes.value = true
End if

Resources