Knowing the assigned name of a cell instead of the "A1" name - vba

Context:
I have several lists in my sheet (1 column wide, 1-10 rows long). When I right click a cell in these lists, I can do several options, that all work well. I have given a name to the cell at the top of each of these lists (ex. Cell A1 has been given the name cell_1, B10 is names cell_2, etc).
I would like to know if the cell I am right clicking on is the one at the top of the list; is it named "cell_(number)"? If it is not, it checks the cell on top of that one. Does it have a name that starts with "cell_"? If not, check the one on top, etc. Until I can figure out the user clicked on an element of WHICH list.
TL;DR The actual question
I can use ActiveCell.Address, which gives me something like "A1" whether or not I have assigned a name to that cell. ActiveCell.Name gives "Sheet1!A1", so it's not much better. Any idea how to get it to return the name I have assigned instead?

Create a UDF to test the application names, it's less efficient but contains error handling within the function itself:
Sub SO()
'// Example how to call function
Debug.Print GetCellName(Range("A1"))
End Sub
Function GetCellName(myCell As Excel.Range) As Variant
Dim nameCheck As Variant
For Each nameCheck In Application.Names
If Replace(Replace(Replace(nameCheck, "=", ""), "'", ""), "!", "") = _
CStr(myCell.Parent.Name & myCell.Address) Then
GetCellName = CStr(nameCheck.Name)
Exit Function
End If
Next
GetCellName = CVErr(Excel.xlErrName)
End Function
Note you can also use this function in a worksheet cell like so:
=GetCellName(A1)

Perhaps this would work. This function returns the names assigned to a cell (or bigger range for that matter). If there's more than one name, it returns it as an array for array formula...or the user can supply an index to return only the desired name position
Public Function CellIsInRangeNames(sheetname As String, checkRange As Range, Optional itemNumber As Variant) As Variant
Dim oNM As Name
Dim oSht As Worksheet
Dim isect As Range
Dim namesCollection() As Variant
Set oSht = Worksheets(sheetname)
Dim i As Integer
i = -1
For Each oNM In oSht.Names
Set isect = Application.Intersect(Range(oNM.Name), checkRange)
If Not isect Is Nothing Then
i = i + 1
ReDim Preserve namesCollection(0 To i)
namesCollection(i) = CStr(oNM.Name)
End If
Next oNM
If i = -1 Then
'didn't find any
CellIsInRangeNames = xlErrName
ElseIf Not IsMissing(itemNumber) Then
'user wanted this instance only
If (itemNumber - 1 > UBound(namesCollection)) Or (itemNumber - 1 < LBound(namesCollection)) Then
CellIsInRangeNames = xlErrValue
Else
CellIsInRangeNames = namesCollection(itemNumber - 1)
End If
Else 'here's the list as an array
CellIsInRangeNames = namesCollection
End If
End Function

Related

LibreOffice Calc: Can I get the cell address from VLOOKUP?

I'm using VLOOKUP, in Calc, like this:
VLOOKUP(B11,G2:J7,4,0)
Normally when any of us uses this, we want to get the value in the cell this function finds. In this case, rather than the value, I'd like to get a string with the cell address in it instead or the row and column of that cell. For instance, if I have a double precision floating point value of 30.14 in cell J5 and that's the answer, rather than having it return 30.14, I want it to return something like "J5" or 9,4 or some other way for me to read the result in a macro.
I've tried using =ADDRESS() and =CELL("address", ) but I'm getting errors (=CELL() gives me '#REF!').
EDIT: I'm using this routine as a wrapper around VLOOKUP with a table of floating point numbers (which is why it returns a DOUBLE instead of getting the cell value as a STRING or something else). All I have to do is pass it the column I want to get the data from:
Function getLookup(valColumn as Integer) as Double
oDoc = ThisComponent
oSheet = oDoc.Sheets (workSheet)
rangeInfo = lookupTopLeft + ":" + lookupBottomRight
cellRange = oSheet.getCellRangeByName(rangeInfo)
oCell = oSheet.GetCellByPosition(dataCellColumn, dataCellRow)
searchValue = oCell.getString()
Mode = 0
svc = createUnoService( "com.sun.star.sheet.FunctionAccess" )
args = Array(searchValue, cellRange, valColumn, Mode)
getLookup = svc.callFunction("VLOOKUP", args)
End Function
Note I'm using some local variables in this. They're private, for the module only, so I don't have to change cell references in multiple places while I'm working on designing my spreadsheet. "lookupTopLeft" and "lookupBottomRight" are "G2" and "J7", the top left and bottom right cells for the data I'm working with. "dataCellColumn", and "dataCellRow" are the column and row coordinates for the source for the key I'm using in VLOOKUP.
(#JohnSUN, I think this may be modified from an answer you provided somewhere.)
I'd like to be able to do a similar wrapper routine that would return the column and row of a cell instead of the value in the cell.
One of many possible options:
Option Explicit
Const lookupTopLeft = "G2"
Const lookupBottomRight = "J7"
Const dataCellColumn = 1
Const dataCellRow = 10
Const workSheet = 0
Function getCellByLookup(valColumn As Integer) As Variant
Dim oSheet As Variant, cellRange As Variant, oCell As Variant
Dim oColumnToSearch As Variant
Dim oSearchDescriptor As Variant
Dim searchValue As String
Dim nRow As Long
oSheet = ThisComponent.getSheets().getByIndex(workSheet)
cellRange = oSheet.getCellRangeByName(lookupTopLeft + ":" + lookupBottomRight)
searchValue = oSheet.GetCellByPosition(dataCellColumn, dataCellRow).getString()
Rem If we are looking not for a value, but for a cell,
Rem then using VLOOKUP is unnecessary, a simple Find is enough
oColumnToSearch = cellRange.getCellRangeByPosition(0, 0, 0, _
cellRange.getRows().getCount()-1) ' Resize full range to one first column
Rem Set search params
oSearchDescriptor = oColumnToSearch.createSearchDescriptor()
oSearchDescriptor.setSearchString(searchValue)
oSearchDescriptor.SearchType = 1 ' Search in Values!
Rem Try to find searchValue in oColumnToSearch
oCell = oColumnToSearch.findFirst(oSearchDescriptor)
If Not IsNull(oCell) Then ' Only if the value was found
nRow = oCell.getRangeAddress().StartRow
Rem Offset oCell to valColumn
oCell = cellRange.getColumns().getByIndex(valColumn-1).GetCellByPosition(0,nRow)
getCellByLookup = Replace(oCell.AbsoluteName, "$", "")
Else ' If the value from B11 is not found - warn about it
getCellByLookup = "Not found"
EndIf
End Function

VBA - improve the calculation efficiency when comparing cells

I'm using the following function to find out whether values of two cells are in two columns.
I have to compare 250 sets of two-cells with 6500 sets of two-cells.
Excel spent 30 seconds to caculate the result.
Could I improve the calculation efficiency?
Public Function CompareWithTwoCells(twoCells As Range, twoCols As Range)
Dim result As String
result = "False"
For n = 1 To twoCols.Rows.Count
If twoCols(n, 1) = "" Then
Exit For
End If
If twoCells(1, 1) = twoCols(n, 1) And twoCells(1, 2) = twoCols(n, 2) Then
result = "True"
Exit For
End If
Next
CompareWithTwoCells = result
End Function
here's a first step of possible enhancements (explanations in comments):
Public Function CompareWithTwoCells(twoCells As Range, twoCols As Range)
Dim cell As Range
Dim firstVal As Variant, secondVal As Variant
firstVal = twoCells(1, 1) ' store first cell value in a variable
secondVal = twoCells(1, 2) ' store second cell value in a variable
CompareWithTwoCells = "False"
For Each cell In twoCols.Columns(1).SpecialCells(xlCellTypeConstants) ' loop through first column not empty values
If firstVal = cell.Value2 Then ' check one column fisrt
If secondVal = cell.Offset(, 1) Then ' check second column only if first columns check is true
CompareWithTwoCells = "True"
Exit For
End If
End If
Next
End Function
a further significant enhancement would use array instead of ranges
Is there a reason you can't just use MATCH=MATCH? (assuming twoCells is A1:B1 and twoCols is F1:G6500)
=IFERROR(MATCH(A1,$F$1:$F$6500,0)=MATCH(B1,$G$1:$G$6500,0),FALSE)
This is almost instant on my machine.
As per #Zac's suggestion, add:
Dim twoCellsArr, twoColsArr
twoCellsArr = twoCells.Value2
twoColsArr = twoCols.Value2
Then change your twoCells and twoCols to twoCellsArr and twoColsArr.
If your twoCols doesn't change and you're doing repeated comparisons i recommend using a Dictionary to store the twoCols.Value as keys and the row number as values, then perform the lookup and comparing whether they are in the same row.

Looping through columns to get column numbers based on headers

I have a template with a set number of columns (170) and title headers (row 1 cell name's). This is always the same, until users add columns in between (they're instructed not to change headers). The idea is to make it tamperproof as far as the adding of columns is involved.
I'd like to make variables to hold some of the headers (with the capacity to hold all) and check these with the template to find out the column number (in a loop I reckon). It's probably wisest to make a function to call upon it?
Dim ColHeader1Str as string 'literal row 1, column 1 value (which is always
'the same string and position in the template)
Dim iColHeader1 as integer 'holds the (to be set) value of the column number
Set ColHeader1Str = "ColHeader1"
Now I'd like a loop where it loops trough all the columns (last column = 200) and checks to see what the column number is that matches the ColHeader1Str and store this in the iColHeader1
So something like:
Function find_columnNmbr
Dim i As Integer
For i = 1 To 200 Step 1
If 'ColHeader1Str matches actual column header name
'set found integer as iColHeader1 and so forth
Exit For
End If
Next
End Function`
I know I'm missing a few steps and I'm hoping you guys can help me out.
Update: The template has set column headers. When users interact with it a result could be that columns shift position, or they add more. I have a workbook that needs to load data out of the user's altered template.
I.E. The template has columns 1, 2, 3, 4 and the names are column1, column 2 etc. A user ads a random column so now there are 5. The loop needs to loop through the names of the column headers and identify the column number of the original template columns 1, 2 etc based on a string variable with the original names, which I've hard coded beforehand. These are public constants.
What function LookForHeaders do: input a string, then search for the string in usersheet.range(1:1). If it is found, return the column number of that cell, otherwise it returns 0.
Private Function LookForHeaders(ByVal headerName As String) As Long
Dim rng As Range
Dim userSheet As WorkSheet
Set userSheet = 'userSheet here'
On Error GoTo NotFound
LookForHeaders = userSheet.Range("1:1").Find(headerName).Column
Exit Function
NotFound:
LookForHeaders = 0
End Function
Private Sub Test()
Dim rng As Range
Dim template As WorkSheet
Set template = 'template here'
For Each rng In template.Range(Cells(1,1), Cells(1,200))
iColHeader1 = LookForHeaders(rng.Value)
'Do something with iColHeader1
Next rng
End Sub
Not sure what your looking for but here is example
Option Explicit
Public Sub Example()
Dim LastCol As Long
Dim i As Long
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For i = 1 To LastCol
If Cells(i) = "Name" Then
Debug.Print Cells(i).Address
End If
Next
End Sub

How do I check whether value in active cell contains any letter or not?

For example cell "A1" is linked to cell "B1", so in formula bar for cell "A1" we have:
=B1
How can I check whether value in cell "A1" contains letter B?
I tried the following:
Dim Criteria_3 As Boolean
Dim Value As Range
Set Value = Selection
Dim x As Variant
Set x = Cells
Dim text As String
For Each x In Value
If IsNumeric(x) Then
Criteria_3 = VBA.InStr(1, x.Formula, text) > 0
As soon as value of "Text" is "" it does not work and I really struggle to fined the right solution.
your question is not really conclusive, so here are two options:
To check wheter the value contains B:
blnCheck = 0 < InStr(1, rngCell.Value, "B")
To check wheter the Formula contains B:
blnCheck = 0 < InStr(1, rngCell.Formula, "B")
Regarding your null string problem:
As soon as value of "Text" is "" it does not work and I really struggle to fined the right solution.
That's because you're using VBA.InStr(1, x.Formula, text) and in this case 1 is an invalid index on a string of length 0. You can omit that, or you can code around it like:
If Len(Trim(x.Formula)) = 0 Then
'## Do nothing
Else
Criteria_3 = VBA.InStr(1, x.Formula, text) > 0
End If
To your specific question of identifying when a value contains any alpha character(s):
You can use a function like this to test whether a value contains any letter, by evaluating the Ascii code for each character, and break when True:
Function ContainsAnyLetter(val) As Boolean
Dim ret As Boolean
Dim str$, ch$
Dim i As Long
str = LCase(CStr(val))
For i = 1 To Len(str)
ch = Mid(str, i, 1)
If 97 <= Asc(ch) And Asc(ch) <= 122 Then
ret = True
Exit For
End If
Next
ContainsAnyLetter = ret
End Function
In your code, you could call it like:
Criteria_3 = ContainsAnyLetter(x.Value) '## or x.Formula, depending on your needs
You can use LIKE
https://msdn.microsoft.com/en-us/library/swf8kaxw.aspx
Something like if rngCell.value like "*B*" then
if your goal is to check whether the cell contains any valid range reference, then you could go like this
Option Explicit
Sub main()
Dim cell As Range
For Each cell In Worksheets("Sheet001").Range("A1:A20") '<== jus a test range, set it as per your needs
MsgBox IsCellReference(cell.Formula)
Next cell
End Sub
Function IsCellReference(text As String) As Boolean
On Error Resume Next
IsCellReference = Not Range(Replace(text, "=", "")) Is Nothing
End Function

Convert VBA Macro to Function

I have been trying to create a function to retrieve column titles found in row four in an excel sheet. This is what I have so far, can anybody help me please?
Sub Test_Click()
Dim text As String
Dim titles(200) As String
Dim nTitles As Integer
For i = 1 To 199
If Trim(Sheets("Sheet1").Cells(4, i).Value) = "" Then
nTitles = i - 1
Exit For
End If
titles(i - 1) = Sheets("Sheet1").Cells(4, i).Value
Next
For i = 0 To nTitles
Sheets("Sheet1").Cells(20 + i, 1).Value = titles(i)
Next
End Sub
You need to make an array function for this. So your function will take in inputs through a range
Function ReturnArray(Input as Range) as Variant
' Do stuff with the Input range
Dim Output(m,n) as Variant
'Loop through m,n to fill in the output values as you would in a range
ReturnArray = Output
End Function
And when you put in the function in excel, type it in the cell after highlighting where you want the output and press Ctrl-Shift-Return
Just as you write a Sub you can write a Function, just substitute the words at the beginning and at the end of your code.
Now, about how to return the values, obviously it will be an array, so you'll need to declare the array, set its size, fill its cells and return it. This can be done like this:
Function yourFunction() as String()
' You already have an array named "titles" which stores the values you want
' to return. Fill it exactly as you do in your original code.
yourFunction = titles ' This is the way to return the array.
End Function
If you want to use this function in a worksheet (as a formula), remember that this is an array-function, so you'll need to press Ctrl+Shitf+Enter after you enter the function in the cell instead of just [Enter].