Convert the Sub below into a built-in Function - excel

I am VERY new to VBA.
I am trying to build a UDF function to parse comma delimited text in a cell into rows. I have a Sub that works fine, but requires a manual "run"; I want it to be a function.
Say I have in cell A1 the following string comma delimited string
M89-76,M64-62,M76-80
and I want to list each M... in a separate row cell. The sub code accomplishes this but requires a manual run; I need a UDF of the sub code so I can type =myUDF(A1) into B1 and the list of M...'s is returned in cells B1 through B3
Sub TransposeRange()
Dim rng As Range
Dim InputRng As Range, OutRng As Range
Set InputRng = Application.Selection.Range("A1")
Set InputRng = Application.InputBox("Range(single cell) :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Arr = VBA.Split(InputRng.Range("A1").Value, ",")
OutRng.Resize(UBound(Arr) - LBound(Arr) + 1).Value =
Application.Transpose(Arr)
End Sub

If you are using a verion that supports Dynamic Arrays (Office365) then your UDF can spill the result into as many cells as required.
Function MyUDF(r As Range) As Variant
Dim s() As String
s = Split(r.Value2, ",")
MyUDF = Application.Transpose(s)
End Function
For data in A put =MyUDF(A1) in Cell B1, the result will spill down
Note that Application.Transpose has a string length limit of 32765 characters. If the data in A1 is longer that that, the result will be truncated. In that case you would need to code the transpose (loop s, into a 2D array)
If you don't have Dynamic Arrays, the formula will still work when entered as an Array Formula into a range large enought to hold the result (eg B1:B3)

If you have FILTERXML (introduced in 2013, thanks T.M.), then you can do this with a formula:
=FILTERXML("<t><x>" & SUBSTITUTE(A1, ",", "</x><x>") & "</x></t>", "//x")
Where you convert the string into an xml formatted tree and then pass in an xpath selector. This will spill into as many rows as are needed.
You can also use this. It's made much simpler by LET, but I'm going to give the non-parameterized version, because if you have LET you should have FILTERXML anyway:
=TRIM(
MID(
SUBSTITUTE(A1, ",", REPT(" ", 100)),
IF(
ROW(OFFSET(A1, 0, 0, LEN(A1)-LEN(SUBSTITUTE(A1,",",""))+1)) = 1,
1,
(ROW(OFFSET(A1, 0, 0, LEN(A1)-LEN(SUBSTITUTE(A1,",",""))+1))-1)*100
),
100
)
)
where you replace the commas with an arbitrarily long amount of whitespace, then use MID to select out substrings, and ROW to generate an array of indexes the size of the elements in the string. Wrap it in TRIM to get rid of the whitespace.
If you need to do this with a UDF, then you can do this:
Function splitIt(raw)
splitIt = Application.Transpose(Split(raw, ","))
End Function
and use it like any other function. This is functionally identical to Chris Nielsen's solution.
Will update shortly with two other options for other Excel versions.

Related

Convert numbers to non-numbers in Excel

I notice that numeric values like 123456 can be considered as numbers or non-numbers in Excel. Mixing numbers and non-numbers may result in unexpected results of = or XLOOKUP.
For instance, in the following worksheet, the formula of D3 is =ISNUMBER(C3) and the formula of D4 is =ISNUMBER(C4). Their values are not the same. Then =C3=C4 in another cell will return FALSE; =XLOOKUP(C3,C4,C4) will return #N/A.
So one solution to avoid such surprises is that I would like to convert all these numeric values from numbers to non-numbers, before applying formulas on them.
Does anyone know if it is possible to undertake this conversion by manual operations (select the range, then...)?
Does anyone know how to achieve this conversion by a subroutine in VBA (select the range, then run the VBA subroutine, then the selected range will be converted)?
If you firstly write numbers in a range, let us say "C:C", formatted as General, any such a cell will return TRUE when you try =ISNUMBER(C4).
If you preliminary format the range as Text and after that write a number, this will be seen by Excel as a String (non-numbers, as you say...) and =ISNUMBER(C4) will return False.
Now, if you will try formatting the range as Text after writing the numbers these cells will not be changed in a way to make =ISNUMBER(C4) returning FALSE. In order to do that, you can use TextToColumns, as in the next example:
Private Sub testTextToCol()
Dim sh As Worksheet, rng As Range
Set sh = ActiveSheet
Set rng = sh.Range("C:C")
rng.TextToColumns Destination:=rng, FieldInfo:=Array(1, 2)
End Sub
It will make the existing =ISNUMBER(C4), initially returning TRUE, to return FALSE...
Of course you cannot compare apples to oranges, thus strings are not comparable to integers/longs/numbers. Make sure that all you compare are apples.
In a routine this would be s.th. like
Option Explicit
Sub changeFormat():
' Declare variables
Dim Number As Variant
Dim check As Boolean
'Converts the format of cells D3 and D4 to "Text"
Range("D3:D4").NumberFormat = "#"
'Assign cell to be evaluated
Number = Range("D3")
Debug.Print Number 'Prints '123'
check = WorksheetFunction.IsText(Trim(Sheets("Tabelle1").Cells(4, 3)))
Debug.Print check 'Prints True
'Converts the format of cells D3 and D4 to "Numbers"
Range("D3:D4").NumberFormat = "0.00"
'Compare Cells
If Range("D3").NumberFormat = Range("D4").NumberFormat Then Range("D5").Value = "Same Format"
End Sub
Also see the docs

Convert vlookup to more than 255 characters via Excel VBA

I am looking for reverse vlookup with more than 255 characters in Excel VBA.
This is the formula based one which I took from this website.
=INDEX(F2:F10,MATCH(TRUE,INDEX(D2:D10=A2,0),0))
I have try to convert it in VBA. Here below sample code
Sub test()
'concat
Range("i1") = WorksheetFunction.TextJoin(" ", True, Range("g1:h1"))
'lookup
Sal1 = Application.WorksheetFunction.Index(Sheets("sheet1").Range("a1:a2"), Application.WorksheetFunction.Match(True, Application.WorksheetFunction.Index(Sheets("sheet1").Range("i1:i1") = Range("i1").Value, 0), 0))
'=INDEX($W$3:$W$162,MATCH(TRUE,INDEX($W$3:$W$162=U3,0),0))
End Sub
It works well but it didn't when i change the range("i1:i1") to range("i1:i2")
I'm not sure what that worksheet formula does that =INDEX(F2:F11,MATCH(A2,D2:D11,FALSE)) doesn't do.
This part Index(Sheets("sheet1").Range("i1:i2") = Range("i1").Value, 0) is comparing a 2-d array to a single value, which should result in a Type Mismatch error. Whenever you reference a multi-cell range's Value property (Value is the default property in this context), you get a 2-d array even if the range is a single column or row.
You could fix that problem with Application.WorksheetFunction.Transpose(Range("D1:D10")) to turn it into a 1-d array, but I still don't think you can compare a 1-d array to a single value and have it return something that's suitable for passing into INDEX.
You could use VBA to create the array's of Trues and Falses, but if you're going to go to that trouble, you should just use VBA to do the whole thing and ditch the WorksheetFunction approach.
I couldn't get it to work when comparing a single cell to a single cell like you said it did.
Here's one way to reproduce the formula
Public Sub test()
Dim rFound As Range
'find A2 in D
Set rFound = Sheet1.Range("D1:D10").Find(Sheet1.Range("A2").Value, , xlValues, xlWhole)
If Not rFound Is Nothing Then
MsgBox rFound.Offset(0, 2).Value 'read column f - same position as d
End If
End Sub
If that simpler formula works and you want to use WorksheetFunction, it would look like this
Public Sub test2()
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
MsgBox wf.Index(Sheet1.Range("F2:F11"), wf.Match(Sheet1.Range("A2").Value, Sheet1.Range("D2:D11"), False))
End Sub
Function betterSearch(searchCell, A As Range, B As Range)
For Each cell In A
If cell.Value = searchCell Then
betterSearch = B.Cells(cell.Row, 1)
Exit For
End If
betterSearch = "Not found"
Next
End Function
i found this code from above link and it is useful for my current search.Below examples i try to get value..
Kindly consider Row 1 to 5 as empty for A and B column because my table always start from Row 6
Row
A Column
B Column
6
54
a
7
55
b
8
56
c
VBA Code:
Sub look_up ()
Ref = "b"
look_up = betterSearch(Ref, Range("B6:B8"), Range("A6:A8"))
End Sub
it show Empty while use Range("B6:B8"), Range("A6:A8")
but when changing the range from B6 and A6 to B1 and A1 (Range("B1:B8"), Range("A1:A8") )it gives the value...
My question is "can get the values from desired range"
Expressing matches via VBA
I like to know if there (are) any possibilities to convert this formula.
=INDEX(F2:F10,MATCH(TRUE,INDEX(D2:D10=A2,0),0))
So "reverse VLookUp" in title simply meant to express the (single) formula result via VBA (btw I sticked to the cell references in OP, as you mention different range addresses in comments).
This can be done by simple evaluation to give you a starting idea:
'0) define formula string
Dim BaseFormula As String
BaseFormula = "=INDEX($F$2:$F$10,MATCH(TRUE,INDEX($D$2:$D$10=$A2,0),0))"
'1) display single result in VB Editor's immediate
Dim result
result = Evaluate(BaseFormula)
Debug.Print IIf(IsError(result), "Not found!", result)
On the other hand it seems that you have the intention to extend the search string range
from A2 to more inputs (e.g. till cell A4). The base formula wouldn't return a results array with this formula,
but you could procede as follows by copying the start formula over e.g. 3 rows (note the relative address ...=$A2 to allow a row incremention in the next rows):
'0) define formula string
Dim BaseFormula As String
BaseFormula = "=INDEX($F$2:$F$10,MATCH(TRUE,INDEX($D$2:$D$10=$A1,0),0))"
'2) write result(s) to any (starting) target cell
'a)Enter formulae extending search cells over e.g. 3 rows (i.e. from $A2 to $A4)
Sheet3.Range("H2").Resize(3).Formula2 = BaseFormula
'b) optional overwriting all formulae, if you prefer values instead
'Sheet3.Range("H2").Resize(3).Value = Tabelle3.Range("G14").Resize(3).Value
Of course you can modify the formula string by any dynamic replacements (e.g. via property .Address(True,True,External:=True) applied to some predefined ranges to obtain absolute fully qualified references in this example).
Some explanations to the used formulae
The formula in the cited link
=INDEX(F2:F10,MATCH(TRUE,INDEX(D2:D10=A2,0),0))
describes a way to avoid an inevitable #NA error when matching strings with more than 255 characters directly.
Basically it is "looking up A2 in D2:D10 and returning a result from F2:F10" similar to the (failing) direct approach in such cases:
=INDEX(F2:F11,MATCH(A2,D2:D11,FALSE))
The trick is to offer a set of True|False elements (INDEX(D2:D10=A2,0))
which can be matched eventually without problems for an occurence of True.
Full power by Excel/MS 365
If, however you dispose of Excel/MS 365 you might even use the following much simpler function instead
and profit from the dynamic display of results in a so called spill range.
That means that matches can be based not only on one search string, but on several ones (e.g. A1:A2),
what seems to solve your additional issue (c.f. last sentence in OP) to extend the the search range as well.
=XLOOKUP(A1:A2,D2:D10,F2:F10,"Not found")

Find address (cell/row) for COUNTIFS function

I have an Excel file populated with a large amount of COUNTIFS functions (above 300). The formulas work fine but I need to be able to find the address for each COUNTIFS result as the data source is very large.
i.e. if COUNTIFs gives me result of 1 for the selected parameters, I need to be able to know which cell/row the function is counting from the data source.
I was thinking this could be done with the ADDRESS function, but I am not sure how this can be used together with COUNTIFS.
I would go with a user-defined function.
Using the below code, you would get this result:
Public Function ListAddresses(SearchTerm As Variant, SearchRange As Range) As String
Dim WS As Worksheet, rCell As Range
Set WS = Sheets(SearchRange.Parent.Name)
SearchTerm = UCase(SearchTerm)
Set SearchRange = Intersect(WS.UsedRange, SearchRange)
For Each rCell In SearchRange.Cells
If UCase(rCell.Value) = SearchTerm Then
ListAddresses = ListAddresses & rCell.Address(False, False) & " | "
End If
Next rCell
If ListAddresses <> "" Then
ListAddresses = Left(ListAddresses, Len(ListAddresses) - 3)
Else
ListAddresses = "<none>"
End If
End Function
Try,
=ADDRESS(AGGREGATE(15, 7, ROW(C$3:INDEX(C:C, MATCH(1E+99, C:C)))/(C$3:INDEX(C:C, MATCH(1E+99, C:C))=1), ROW(1:1)), COLUMN(B:B), 4, 1, "Shett4")
Assuming your criteria rows are aligned, you can find the rows that are going into the count. Referencing the image below, enter this as an array formula (Ctrl+Shift+Enter) in an area with the same number of rows that the COUNTIFS returned (I entered the formula into H2:H4 in the image):
=SMALL(IF(((A2:A11=F1)+(B2:B11=F2)+(C2:C11=F3))=3,ROW(A2:A11)),ROW(INDIRECT("1:"&F4)))

How to do SUMIFS text match with multiple criteria from another column?

I wish to categorize my transactions in a way where I can alter the categories on the fly. I think it's easier explained by showing what I have.
I have the following tables
Transactions
A: Date
C: Name
D: Amount
Fast Food List:
L: Name (partial name since going to be doing string search)
I wish to sum the transaction amount based on multiple criteria, such as date and category. Here's a formula that works:
=SUMIFS(D:D,A:A,"*03/2013*",C:C,"*"&L3&"*")
There's one fundamental problem: it only supports ONE item from the Fast Food List. Is there any way I can simply do a text stringth search across the entire Fast Food names?
""&L3&"" to ""&L:L&"" or something?
Here are some things I've tried.
1) Modify the SUMIFS criteria ""&L3&"" with a boolean UDF. The issue I run into here is that I can't figure out how to pass the current Row being looped by SUMIF into the function.
Public Function checkRange(Check As String, R As Range) As Boolean
For Each MyCell In R
If InStr(Check, MyCell.Value) > 0 Then
checkRange = True
End If
Next MyCell
End Function
If I could send Check to this function, well I would be set.
2) Replace the sum_range of the SUMIFS with a UDF that returns the range of rows
Public Function pruneRange(Prune_range As Range, Criteria_range As Range) As Range
Dim Out_R As Range
Dim Str As String
ActiveWorkbook.Sheets("Vancity Trans").Activate
' Loop through the prune_range to make sure it belongs
For Each Cell In Prune_range
' loop through criteria to see if it matches current Cell
For Each MyCell In Criteria_range
If InStr(Cell.Value, MyCell.Value) > 0 Then
' Now append cell to Out_r and exit this foreach
' Str = Str & Cell.Address() & ","
Str = Str & "D" & Cell.Row() & ","
Exit For
End If
Next MyCell
Next Cell
' remove last comma form str
Str = Left(Str, Len(Str) - 1)
' use str to set the range
Set Out_R = Range(Str)
' MsgBox (Str)
Set pruneRange = Out_R
End Function
This works for a regular SUM loop, but for some reason it returns #Value when I try using it in a SUMIF or SUMIFS. Another issue is that even in the SUM loop if use C:C instead of C1:CX where X is however many rows, it crashes excel or takes forever to loop through. I'm guessing it's because excel doesn't know when to stop in a UDF unless I somehow tell it to?
Try this formula
=SUMPRODUCT(SUMIFS(D:D,A:A,"*03/2013*",C:C,"*"&L3:L30&"*"))
By using a range (L3:L30) for the final criterion the SUMIFS formula will generate an "array" (of 28 values - one for each value in L3:L30) ...and SUMPRODUCT is used to sum that array and get the result you want

Add text of cell range in one cell in Excel

I want to concatenate a range of cells into one cell, without macros/vbscript.
The formula CONCATENATE() gets individual cells.
Its not that easy, but I end up with a solution that works wonders!
A1: the text to search
B1:BN: The range within the results would go
B5: The delimiter text
=MID($A$1,LEN(CONCAT($B$1:B1))+COUNTA($B$1:B1)*LEN($B$5)+1,
SEARCH(
$B$5,
$A$1,
LEN(
CONCAT($B$1:B1)) + COUNTA($B$1:B1)*LEN($B$5)+1)
-(LEN(CONCAT($B$1:B1))+COUNTA($B$1:B1)*LEN($B$5)+1))
As for now it works perfect. Note that you can use whatever text as delimiter. In my case it was "comma + space".
Where Concat is a simple function that concatenates a range of cells:
Function Concat(myRange As Range) As String
Dim r As Range
Application.Volatile
For Each r In myRange
If Len(r.Text) Then
Concat = Concat & IIf(Concat <> "", "", "") & r.Text
End If
Next
End Function
You can either use CONCATENATE() or & to join cells. There is no range you can grab all at once unless you use a UDF such as MCONCAT.

Resources