I'm working on a function that returns the formula of its input cell, replacing all references to other cells with the cells' values. My current implementation works fine unless the input cell contains absolute references, which is what I'd like to improve upon.
Currently, I extract the Range.FormulaR1C1 property of the input cell and replace all addresses with values of their respective cells. It's fairly easy to recognize relative addresses, because they contain square brackets, i.e. []. The general format is R[rN]C[cN] with rN and cN denoting relative row or column numbers (integer values) - if either of these equals zero, it gets omitted along with the brackets, so there's two possibilities for a position in a formula to be the start of an address:
Next two characters are "R["
Next three characters are "RC["
(Self referencing is not allowed, so we can exclude "RC".)
When we introduce absolute addresses, the brackets disappear and the general address format becomes RrNCcN. Now it gets more complicated to recognize an address and I'd prefer to stick to the two simple rules R[ and RC[. If I could convert absolute cell references to relative and return them in the R1C1 format, I could leave the current implementation unchanged.
I need to get a cell's formula in the R1C1 format, with all absolute cell references replaced by relative ones. It's theoretically very simple to remove absolute references from an address in the A1 format (Range.Formula property) by just removing all "$" signs. Alas, I don't know how to convert the address back to R1C1 format after doing that. Below is a naive implementation which fails on the penultimate row, but captures the idea I think. I have no clue on how to proceed or if it's even possible to do this as simply as I imagine.
Function returnRelativeFormulaR1C1(refCell As Range) As String
Dim refAddress As String, addressLength As Integer, posRow As Integer, posCol As Integer, iColNr As Integer
refAddress = refCell.Address(ReferenceStyle:=xlR1C1)
addressLength = Len(refAddress)
iColNr = InStr(2, refAddress, "C")
posRow = Val(Mid(refAddress, 2, iColNr - 1)) ' Begin at 2, because there's always "R" at the beginning
posCol = Val(Mid(refAddress, iColNr + 1, addressLength - iColNr))
Dim formulaText As String
formulaText = Cells(posRow, posCol).Formula ' Get formula in A1 format
Dim formulaTextRelative As String
formulaTextRelative = Replace(formulaText, "$", "") ' Remove "$" signs, i.e. convert absolute references to relative
Dim convRange As Range
Set convRange = refCell
convRange.Cells(1, 1).Formula = formulaTextRelative ' Assign the converted formula to a virtual cell? The code fails here.
returnRelativeFormulaR1C1 = convRange.Cells(1, 1).FormulaR1C1 ' If the previous row worked, this should then take care of the conversion back to R1C1 format.
End Function
Many thanks to chris neilsen, ConvertFormula was just what I needed.
Corrected implementation of the conversion:
Function returnRelativeFormulaR1C1(refCell As Range) As String
Dim refAddress As String, addressLength As Integer, posRow As Integer, posCol As Integer, iColNr As Integer
refAddress = refCell.Address(ReferenceStyle:=xlR1C1)
addressLength = Len(refAddress)
iColNr = InStr(2, refAddress, "C")
posRow = Val(Mid(refAddress, 2, iColNr - 1)) ' Begin at 2, because there's always "R" at the beginning
posCol = Val(Mid(refAddress, iColNr + 1, addressLength - iColNr))
Dim formulaTextA1 As String
formulaTextA1 = Cells(posRow, posCol).Formula ' Get formula in A1 format
Dim formulaTextA1Relative As String
formulaTextA1Relative = Replace(formulaTextA1, "$", "") ' Remove "$" signs, i.e. convert absolute references to relative
returnRelativeFormulaR1C1 = Application.ConvertFormula(Formula:=formulaTextA1Relative, fromReferenceStyle:=xlA1, toReferenceStyle:=xlR1C1, RelativeTo:=refCell) ' Convert back to R1C1
End Function
Related
As mentioned in the title, I wonder if there is any way to use built-in functions in excel to see whether a cell contains a specific number and count the total numbers in the cell. The cell can contain a list of numbers seperated by comas, for instance, "1,4,7" or ranges "10-25" or a combination of both. See the print screen.
No, there is not, but you could write a VBA function to do that, something like:
Function NumberInValues(number As String, values As String) As Boolean
Dim n As Integer
n = CInt(number)
Dim parts() As String
parts = Split(values, ",")
For i = LBound(parts) To UBound(parts)
parts(i) = Replace(parts(i), " ", "")
Next
Dim p() As String
Dim first As Integer
Dim last As Integer
Dim tmp As Integer
For i = LBound(parts) To UBound(parts)
p = Split(parts(i), "-")
' If there is only one entry, check for equality:
If UBound(p) - LBound(p) = 0 Then
If n = CInt(p(LBound(p))) Then
NumberInValues = True
Exit Function
End If
Else
' Check against the range of values: assumes the entry is first-last, does not
' check for last > first.
first = CInt(p(LBound(p)))
last = CInt(p(UBound(p)))
If n >= first And n <= last Then
NumberInValues = True
Exit Function
End If
End If
Next
NumberInValues = False
End Function
and then your cell C2 would be
=NumberInValues(B2,A2)
Calculating how many numbers there are in the ranges would be more complicated as numbers and ranges could overlap.
The key part of implementing this is to create a List or Array of individual numbers that includes all the Numbers represented in the first column.
Once that is done, it is trivial to check for an included, or do a count.
This VBA routine returns a list of the numbers
Option Explicit
Function createNumberList(s)
Dim AL As Object
Dim v, w, x, y, I As Long
Set AL = CreateObject("System.Collections.ArrayList")
v = Split(s, ",")
For Each w In v
'If you need to avoid duplicate entries in the array
'uncomment the If Not lines below and remove the terminal double-quote
If IsNumeric(w) Then
'If Not AL.contains(w) Then _"
AL.Add CLng(w)
Else
x = Split(w, "-")
For I = x(0) To x(1)
'If Not AL.contains(I) Then _"
AL.Add I
Next I
End If
Next w
createNumberList = AL.toarray
End Function
IF your numeric ranges might be overlapping, you will need to create a Unique array. You can do that by changing the AL.Add function to first check if the number is contained in the list. In the code above, you can see instructions for that modification.
You can then use this UDF in your table:
C2: =OR($B2=createNumberList($A2))
D2: =COUNT(createNumberList($A2))
Here is a possible formula solution using filterxml as suggested in the comment:
=LET(split,FILTERXML("<s><t>+"&SUBSTITUTE(A2,",","</t><t>+")&"</t></s>","//s/t"),
leftn,LEFT(split,FIND("-",split&"-")-1),
rightn,IFERROR(RIGHT(split,LEN(split)-FIND("-",split)),leftn),
SUM(rightn-leftn+1))
The columns from F onwards show the steps for the string in A2. I had to put plus signs in because Excel converted a substring like "10-15" etc. into a date as usual.
Then to find if a number (in C2 say) is present:
=LET(split,FILTERXML("<s><t>+"&SUBSTITUTE(A2,",","</t><t>+")&"</t></s>","//s/t"),
leftn,LEFT(split,FIND("-",split&"-")-1),
rightn,IFERROR(RIGHT(split,LEN(split)-FIND("-",split)),leftn),
SUM((--leftn<=C2)*(--rightn>=C2))>0)
As noted by #Ron Rosenfeld, it's possible that there may be duplication within the list: the Count formula would be susceptible to double counting in this case, but the Check (to see if a number was in the list) would give the correct result. So the assumptions are:
(1) No duplication (I think it would be fairly straightforward to check for duplication, but less easy to correct it)
(2) No range in wrong order like 15-10 (although this could easily be fixed by putting ABS around the subtraction in the first formula).
Here is a little cheeky piece of code for a VBA solution:
Function pageCount(s As String)
s = Replace(s, ",", ",A")
s = Replace(s, "-", ":A")
s = "A" & s
' s now looks like a list of ranges e.g. "1,2-3" would give "A1,A2:A3"
pageCount = Union(Range(s), Range(s)).Count
End Function
because after all the ranges in the question behave exactly like Excel ranges don't they?
and for inclusion (of a single page)
Function includes(s As String, m As String) As Boolean
Dim isect As Range
s = Replace(s, ",", ",A")
s = Replace(s, "-", ":A")
s = "A" & s
Set isect = Application.Intersect(Range(s), Range("A" & m))
includes = Not (isect Is Nothing)
End Function
I have two cells with numbers i.e. A1 and B1. I need a formula to get the digits in A1 which are present in B1 to be shown in cell B2.
In below example, all digits in A1 i.e. 5,3,9,4 are found in B1 and therefore shall be shown in cell B2
cell A1 = 5394
cell B1 = 7284395
cell B2 = 5394 [formula result]
Thank you
The below code will work. It divides the SearchTerm into individual character strings called SearchTerm_Individual based on the length of the SearchTerm. The code further appends the individual characters to the result cell, if found in the SearchIn String.
Option Explicit
Sub Search_Item2()
Dim SearchTerm As String
Dim SearchIn As String
Dim SearchTerm_Length As Integer
Dim X As Byte
SearchTerm = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
SearchIn = ThisWorkbook.Sheets("Sheet1").Range("B1").Value
SearchTerm_Length = Len(SearchTerm)
Dim SearchTerm_Individual() As String
ReDim SearchTerm_Individual(1 To SearchTerm_Length) As String
For X = 1 To SearchTerm_Length
SearchTerm_Individual(X) = Mid(SearchTerm, X, 1)
If InStr(SearchIn, SearchTerm_Individual(X)) > 0 Then
ThisWorkbook.Sheets("Sheet1").Range("C1").Value = ThisWorkbook.Sheets("Sheet1").Range("C1").Value & SearchTerm_Individual(X)
End If
Next X
End Sub
The function below will work but is limited to 4 characters in A1.
=IF(AND(ISNUMBER(FIND(MID(A1, 1, 1), B1)), ISNUMBER(FIND(MID(A1, 2, 1), B1)), ISNUMBER(FIND(MID(A1, 3, 1), B1)), ISNUMBER(FIND(MID(A1, 4, 1), B1))), A1, "")
This looks at each character in A1 using MID(). It passes that to FIND() to see if that character is in B2. It uses ISNUMBER() around FIND() to see if it's getting a valid numerical result. In this case it's easier than checking for an error. It uses AND() to check that all 4 characters are in B2.
Again, this will work but is not flexible at all regarding the length if the text in A1. You likely want something different. Please share more info about what you're trying to accomplish.
The thing is not always the amount of values (IDs) will be the same within each cell (at least 1, max=several) that's why the fixed version of using concatenated vlookup+left/mid/right will not work for me due to that will solution will only work up to 3 values. The only fixed size is the size of the values to lookup (IDs - in green), 8 characters (letters+numbers).
I'm not sure but, is it possible to setup a loop within excel formulas/functions ?
Below is a table containing an example of the issue I'm trying to resolve and the expected values (tables are in different tab). Hope you can help.
Thanks.
example-tables
If you have windows Excel O365 with the TEXTJOIN and FILTERXML functions, you can use a formula:
=TEXTJOIN(",",TRUE,IFERROR(XLOOKUP(FILTERXML("<t><s>" & SUBSTITUTE(#[IDs],",","</s><s>") & "</s></t>","//s"),Table2[IDs],Table2[IDv2]),"""--"""))
Note that, in your data, there are two ID's in A4 that do not match any ID's in Table 2. Although that may be a typo, I left them as is to demonstrate the error handling.
Table1
Table2
Here is a UDF that will do what you describe. Paste the code into a standard code module (not one already existing in the workbook but one that you create and that would have a name like Module1 before you change it to what you like best. You can also rename the function to give it a more suitable name.
Function ID_v2(Cell As Range) As String
' 035
Dim Fun As String ' function return value
Dim Sp() As String ' array of CSVs of CellVal
Dim VLRng As Range ' the lookup range
Dim VL As Variant ' result of VLookup
Dim i As Integer ' loop counter
' this is a range similar to your sample A10:D19
Set VLRng = ThisWorkbook.Names("Table2").RefersToRange
Sp = Split(Cell.Cells(1).Value, ",")
If UBound(Sp) >= 0 Then
For i = 0 To UBound(Sp)
On Error Resume Next
VL = Application.VLookup(Trim(Sp(i)), VLRng, 3, False)
If Err Then VL = "[ERROR]"
Fun = Fun & VL & ","
Next i
ID_v2 = Left(Fun, Len(Fun) - 1) ' remove final comma
End If
End Function
Call the function with syntax like built-in functions. For example,
= ID_v2(A3)
This can be copied down like any other function. But remember to save the workbook as macro-enabled.
Try this:
Option Explicit
Sub Cell2List()
Dim wF As WorksheetFunction: Set wF = Application.WorksheetFunction 'To user Transpose
Dim i As Range
Dim j As Range
Dim s As String: s = "," 'The separator of the list
'Ask the user for the cell where are the list with the commas
'Just need to select the cell
Set i = Application.InputBox("Select just one cell where the values are", "01. Selecte the values", , , , , , 8)
'Ask the for the separator. If you are completely sure the comma will never change just delete this line
s = Application.InputBox("Tell me, what is the character separator, just one character! (optional)", "02. Separator (comma semicolon colon or any other char)", , , , , , 2)
If s = "" Then s = "," 'Verifying...........
'Ask the user where want to put the list
'You need to get ready the cells to receive the list.
'If there any data will be lost, the macro will overwrite anything in the cells
Set j = Application.InputBox("Select just one cell where the values will go as a list, just one cell!", "03. Selecte the cell", , , , , , 8)
Dim myArr: myArr = (Split(i.Value, s)) 'Split the list into a Array
Range(Cells(j.Row, j.Column), Cells(j.Row + UBound(myArr), j.Column)).Value = wF.Transpose(myArr)
'j.Row is the row of the cell the user selected to put the cell
'j.Column the same, but the column
'j.Row + UBound(myArr) = UBound(myArr) is the total count of elements in the list
' +j.Row
' _______________
' the last cell of the new list!
'wF.Transpose(myArr) = we need to "flip" the array... Don't worry, but Don't change it!
End Sub
You can put this macro with a button tin the ribbons, or use it as you can see in the gif
And this will be the result: (with a bigger list)
EDIT
You can use this UDF:
Function Cells2List(List As Range, Pos As Integer) As String
Cells2List = Split(List, ",")(Pos - 1)
End Function
Just need to define and index this way:
To tell the function, what index you want to see. You can use the function using ROW()-# to define an 1 at the beginning and when the formula send a #VALUE! delete the formulas. Where $A$1 is where the list are, and D7 is where the index are.
I have entries in cells like this:
75864543&m
2211842
1523674&mr
3452435tr
The cells have varying numbers of numeric values, and some have characters/letters at the end. I want to trim everything off except numeric values, but am stuck due to the varying length of number values.
Does anyone have a workaround?
Assuming between 1 & 9 digits at the start of the data (adjust as required) you can use this formula
=LOOKUP(10^10,LEFT(A1,{1,2,3,4,5,6,7,8,9})+0)
Try the following User Defined Function:
Public Function ReturnNumerals(rng As Range) As String
Dim sStr As String, i As Long, sStr1 As String
Dim sChar As String
sStr = rng.Value
For i = 1 To Len(sStr)
sChar = Mid(sStr, i, 1)
If sChar Like "[0-9]" Then
sStr1 = sStr1 & sChar
End If
Next
ReturnNumerals = sStr1
End Function
EDIT #1:
If you are "macrophobic" or VBA is ruled out for other reasons, Then try this array formula:
=MID(SUMPRODUCT(--MID("01"&A1,SMALL((ROW($1:$300)-1)*ISNUMBER(-MID("01"&A1,ROW($1:$300),1)),ROW($1:$300))+1,1),10^(300-ROW($1:$300))),2,300)
Array formulas must be entered with CNTRL-SHFT-ENTER rather than just the ENTER key!
For example, if A1 contains:
a123wer98bg5
the ugly array formula will return:
123985
I am unable to split a single cell's value into two different strings and put both of those strings in different cells.
For instance I want to take a measurement 10ft x 20ft value in a cell and take the 10ft and put it in another cell, and take the 20ft and put it in a completely different cell.
I'd like to use a delimiter x or something, but I just don't know how to take those separations and do something with them after the split.
Any tips would be much appreciated. I'm still pretty new to VBA macros.
Thanks
The best solution is using SPLIT
Dim strX As String
Dim sx() As String
Dim i as Integer
strX = "10FT x 20FT"
sx = Split(strX, "x")
Or maybe you can use instr function
Dim sVar1 as string
Dim sVar2 as string
I = InStr(1, strX, "x")
Now you know where can split int two variables
sVar1 = mid(strX, 1, I)
sVar2 = mid(strx,i+1)
The problem with the function is that if you have several keys in the chain with which you want to separate your function will return an array larger.
For example:
Dim var as string
var = "x 20XP 10XP"
returns
array (0) = "10"
array (1) = "p"
array (2) = "20"
array (3) = "p"
You don't actually need VBA. You can use Excel's Text to Columns
For example, in excel-2010
Data ..... Text to Columns
Pick delimited and press Next
Check Space and put 'x' in Other and press Next
Finish
Guess I just needed to look a little harder.
Sub Split_CutArea()
Dim str1() As String
Dim str2() As String
Dim avarsplit As Variant
avarsplit = Split(Cells(4, "B").Value, "x")
splitValues = Split(ActiveSheet.Cells(4, "B").Value)
ActiveSheet.Cells(22, "B").Value = splitValues(0) & splitValues(1)
ActiveSheet.Cells(23, "B").Value = splitValues(3) & splitValues(4)
End Sub