I have a comma separated lists in cells. All numbers are positive and between 1 and 10.
Example:
if I have in A1: (2,3,5,6), I would like to have missing numbers in B1:(1,4,7,8,9,10).
If A2: (1,10), then I would have in B2:(2,3,4,5,6,7,8,9)
If A3: (7), then I would have in B2:(1,2,3,4,5,6,8,9,10)
I searched for a solution online, but I couldn't find anything similar with comma separated numbers.
I'd be glad if I can have a solution here. Thanks.
Here is a user-defined function that should accomplish this... probably can be optimized.
Public Function MissingNumbers(ByVal numberList As String) As String
Dim temp As String
temp = Replace(numberList, "(", "")
temp = Replace(temp, ")", "")
Dim arr As Variant
arr = Split(temp, ",")
Dim newNumbers As String
newNumbers = "1,2,3,4,5,6,7,8,9,10,"
Dim i As Long
For i = LBound(arr) To UBound(arr)
newNumbers = Replace(newNumbers, arr(i) & ",", "")
Next
newNumbers = "(" & Left$(newNumbers, Len(newNumbers) - 1) & ")"
MissingNumbers = newNumbers
End Function
Just for fun demonstrating how to use negative filtering:
Function MissingList(ByVal numberList As String) As String
Dim given: given = Split(Mid(numberList, 2, Len(numberList) - 2), ",")
Dim series: series = GetSeries() ' i.e. numbers 1..10
Dim i As Long
For i = 0 To UBound(given)
series = Filter(series, given(i), False) ' << negative filtering
Next
MissingList = "(" & Replace(Join(series, ","), "0", "10") & ")"
End Function
As Filter executes a partial search in the 1..10 series, 10 has to be replaced temporarily by a unique 0.
Help function GetSeries()
Function GetSeries()
' Purpose: get numbers 1..10
Const LAST As Long = 10: Const FIRST = 1
Dim tmp: tmp = Application.Transpose(Evaluate("row(" & FIRST & ":" & LAST & ")"))
tmp(LAST) = 0 ' replace 10 by 0 as search item 1 would filter out value 10, too
GetSeries = tmp
End Function
Related
If I have a UDF that has the parameters as such:
=MySampleUDF(150+127.193,1000,240-30-12)
How can I use VBA to reduce the above to this (i.e. calculate & simplify all the parameters):
=MySampleUDF(277.193,1000,198)
I've tried to think of ways that involve Regex, but really there must be a simpler way?
So, you want to Evaluate each parameter in the Formula, and turn it into a single value?
The method below is far from perfect; if your parameter includes a formula, then it will fail (e.g. =MySampleUDF(150+127.193,999+1+PRODUCT(7+3,0),240-30-12) will result in =MySampleUDF(277.193,999+1+PRODUCT(10,0),198)), but it forms an almost-decent starting point, and doesn't require any advanced understanding. There are, undoubtedly, many ways to improve it, with more time.
Sub SimplifyParameters(Target AS Range)
Dim aBrackets AS Variant, bClose As Boolean, aParams AS Variant
Dim lCurrBracket AS Long, lCurrParam As Long, rCurrCell AS Range
Dim sProcessBracket AS String, vEvaluated AS Variant
For Each rCurrCell In Target.Cells 'In case you input more than 1 cell
If Len(rCurrCell.Formula)>0 Then 'Ignore blank cells
aBrackets = Split(rCurrCell.Formula, "(") 'Split by Function
For lCurrBracket = lBound(aBrackets) to UBound(aBrackets)
aProcessBracket = aBrackets(lCurrBracket)
bClose = (Right(sProcessBracket,1)=")")
If bClose Then sProcessBracket = Left(sProcessBracket, Len(sProcessBracket)-1)
aParams = Split(sProcessBracket, ",") 'Split by Parameter
For lCurrParam = lBound(aParams) to uBound(aParams)
vEvaluated - Evaluate(aParams(lCurrParam))
If Not IsError(vEvaluated) Then aParams(lCurrParam) = vEvaluated
Next lCurrParam
aBrackets(lCurrBracket) = Join(aParams, ",") & IIF(bClose, ")", "") 'Recombine Parameters
Next lCurrBracket
rCurrCell.Formula = Join(aBrackets, "(") 'Recombine Functions
End If
Next rCurrCell
End Sub
It Splits the Formula on "(", to separate functions
"=MySampleUDF(150+127.193,1000,240-30-12)"
[0] = "=MySampleUDF"
[1] = "150+127.193,1000,240-30-12)"
Then it goes through those, removes the ")", and Splits them on ","
"=MySampleUDF"
[0] = "=MySampleUDF"
"150+127.193,1000,240-30-12"
[0] = "150+127.193"
[1] = "1000"
[2] = "240-30-12"
Then it runs the Evaluate function on each of those and, if the result is not an error, substitutes it in
Evaluate("=MySampleUDF") = Error 2029
Evaluate("150+127.193") = 277.193
Evaluate("1000") = 1000
Evaluate("240-30-12") = 198
Then it Joins the Parameters back together, and restores any removed ")"
Join(Array("=MySampleUDF"), ",") & "" = "=MySampleUDF"
Join(Array(277.193, 1000, 198), ",") & ")" = "277.193,1000,198)"
Finally, it Joins the Functions back together
Join(Array("=MySampleUDF", "277.193,1000,198)"), "(") = "=MySampleUDF(277.193,1000,198)"
Here is a subroutine that takes the selected cell and parses out the arguments of the any function, then evaluates each one and re-composes the formula definition.
For example the selected cell has =SUM(1+2+3,10) as formula.
After calling the sub the cell has =SUM(6,10) as formula
Public Sub EvalParams()
Dim r As Range
For Each r In Selection
Dim f As String
f = r.Formula
If Left(f, 1) = "=" Then
Dim i_open As Long
i_open = InStr(2, f, "(")
Dim id As String
' Get UDF name
id = Mid(f, 2, i_open - 2)
Dim i_close As Long
i_close = InStr(i_open + 1, f, ")")
Dim args() As String
' Seperate arguments by comma
args = VBA.Split(Mid(f, i_open + 1, i_close - i_open - 1), ",")
Dim i As Long
' Evaluate each argument separately
For i = 0 To UBound(args)
args(i) = CStr(Evaluate(args(i)))
Next i
' Compose formula again
f = "=" & id & "(" & VBA.Join(args, ",") & ")"
r.Formula = f
End If
Next r
End Sub
NOTE: This will fail if you have multiple function calls in the formula, like
=SUM(1,2,3) + SUM(4,5)
A B C
1 numbers signs **Result**
2 *001* *alpha* 001-alpha
3 *001*111*221*104* *alpha*kappa*epislon*ETA* 001-alpha, 111-kappa, 221-epislon, 104-ETA
4 *001*085* *alpha*delta* 001-alpha, 085-delta
I'm trying to concatenate the values in columns A and B into the following format under the result section. Anything helps, thanks.
Formula solution
Using Textjoin and Filterxml function, of which Textjoin available in Office 365 or Excel 2019 and Filterxml available in Excel 2013 & later versions of Excel
In C2, array formula (confirm by pressing Ctrl+Shift+Enter) copied down :
=TEXTJOIN(", ",1,IFERROR(TEXT(FILTERXML("<a><b>"&SUBSTITUTE(A2,"*","</b><b>")&"</b></a>","//b"),"000")&FILTERXML("<a><b>"&SUBSTITUTE(B2,"*","</b><b>-")&"</b></a>","//b"),""))
I'm assuming this is doable with formulas but it might get unwieldy, so perhaps a UDF like this:
Public Function JoinNumbersAndSigns(ByVal numbersRng As Range, ByVal signsRng As Range) As String
Dim nums As String
nums = numbersRng.Cells(1).Value
nums = Mid$(nums, 2, Len(nums) - 2) ' remove leading and trailing *
Dim signs As String
signs = signsRng.Cells(1).Value
signs = Mid$(signs, 2, Len(signs) - 2) ' remove leading and trailing *
Dim tempNums As Variant
tempNums = Split(nums, "*")
Dim tempSigns As Variant
tempSigns = Split(signs, "*")
Dim i As Long
For i = LBound(tempNums) To UBound(tempNums)
Dim tempString As String
Dim sep As String
tempString = tempString & sep & tempNums(i) & "-" & tempSigns(i)
sep = ", "
Next i
JoinNumbersAndSigns = tempString
End Function
In Action:
The nums = Mid$(nums, 2, Len(nums) - 2) and similar line for signs could probably be made more robust, but should work given your current data.
Here's another approach using regular expressions ...
Option Explicit
Public Function Link(vNumbers As Range, vSigns As Range) As Variant
' ADD REFERENCE TO "Microsoft VBScript Regular Expressions 5.5"
Dim vRegEx As New RegExp
Dim vNumbersMatches As MatchCollection
Dim vSignsMatches As MatchCollection
Dim vCounter As Long
' The two parameters must only reference a single cell
If vNumbers.Cells.Count <> 1 Or vSigns.Cells.Count <> 1 Then
Link = CVErr(xlErrRef)
Exit Function
End If
' use regular expression to get the numbers
vRegEx.Pattern = "([0-9]+)"
vRegEx.Global = True
vRegEx.MultiLine = True
Set vNumbersMatches = vRegEx.Execute(vNumbers.Text)
' Use regular expression to get the signs
vRegEx.Pattern = "([^\*]+)"
vRegEx.Global = True
vRegEx.MultiLine = True
Set vSignsMatches = vRegEx.Execute(vSigns.Text)
' If the number of Numbers and Signs differs, then return an error
If vNumbersMatches.Count <> vSignsMatches.Count Then
Link = CVErr(xlErrValue)
Exit Function
End If
' Loop through the Numbers and Signs, appending each set
For vCounter = 0 To vNumbersMatches.Count - 1
Link = Link & vNumbersMatches.Item(vCounter) & "-" & vSignsMatches.Item(vCounter) & IIf(vCounter < vNumbersMatches.Count - 1, " ,", "")
Next
End Function
And the output ...
As long as there will always be a correlation between the number of elements in A & B this will work
Sub SplitandConcat()
' Declare working vars
Dim lRow As Long: lRow = 2
Dim sOutputString As String
Dim iWorkIndex As Integer
Dim CommaSpace As String
While ActiveSheet.Cells(lRow, 1) <> ""
CommaSpace = ""
'Split the incoming string on delimiter
arInput1 = Split(ActiveSheet.Cells(lRow, 1), "*")
arInput2 = Split(ActiveSheet.Cells(lRow, 2), "*")
' For each non blank item in the 1st array join the corresponding item int the second
For iWorkIndex = 0 To UBound(arInput1)
If arInput1(iWorkIndex) <> "" Then
ActiveSheet.Cells(lRow, 3) = ActiveSheet.Cells(lRow, 3) & CommaSpace & arInput1(iWorkIndex) & "-" & arInput2(iWorkIndex)
CommaSpace = ", "
End If
Next iWorkIndex
' check next row
lRow = lRow + 1
Wend
End Sub
For Example,
I'd like a String such as, "This is a Bunch of Words in a sequence of 13 possible 1 words from a Dictionary or BookZZ or Libgen.io 1876" to give me a result of 19 (because "13", "1876" and "1" are numbers and should not be counted).
I created Two Functions which I'm trying to use within this Function I'm asking about:
The first one is the following:
' NthWord prints out the Nth Word of a String of Text in an Excel Cell such
' as A1 or B19.
Function NthWord(ActiveCell As String, N As Integer)
Dim X As String
X = ActiveCell
X = Trim(Mid(Replace(ActiveCell, " ", Application.WorksheetFunction.Rept("
", Len(ActiveCell))), (N - 1) * Len(ActiveCell) + 1, Len(ActiveCell)))
NthWord = X
' In the Excel SpreadSheet:
' Trim (Mid(Substitute(A1, " ", Rept(" ", Len(A1))), (N - 1) * Len(A1)
' + 1, Len(A1)))
End Function
The second one is the following:
'NumberOfWords returns the number of words in a String
Function NumberOfWords(ActiveCell As String)
Dim X As String
X = ActiveCell
Dim i As Integer
i = 0
If Len(Trim(X)) = 0 Then
i = 0
Else:
i = Len(Trim(X)) - Len(Replace(X, " ", "")) + 1
End If
NumberOfWords = i
' In the Excel SpreadSheet
' IF(LEN(TRIM(A1))=0,0,LEN(TRIM(A1))-LEN(SUBSTITUTE(A1," ",""))+1)
End Function
My Attempt at printing the NumberOfNonNumberWords
Function NumberOfNonNumberWords(ActiveCell As String)
Dim X As String
X = ActiveCell
Dim count As Integer
count = 0
Dim i As Integer
If NumberOfWords(X) > 0 Then
For i = 1 To NumberOfWords(X)
If Not (IsNumeric(NthWord(X, i).Value)) Then
count = count + 1
End If
Next i
End If
NumberOfNonNumberWords = count
End Function
However, when I apply this function in the Excel Worksheet, I get an output of
#VALUE!
and I'm not sure why. How do I fix this?
Split the whole string then count non-numeric elements.
function abcWords(str as string) as long
dim i as long, arr as variant
arr = split(str, chr(32))
for i=lbound(arr) to ubound(arr)
abcWords = abcWords - int(not isnumeric(arr(i)))
next i
end function
You could just use SPLIT() to split the text on a space delimiter, then count the non-numeric words:
Function num_words(ByVal text As String)
Dim txt_split
txt_split = Split(text, " ")
Dim total_words As Long
total_words = 0
Dim i As Long
For i = LBound(txt_split) To UBound(txt_split)
If Not IsNumeric(txt_split(i)) Then
total_words = total_words + 1
End If
Next i
num_words = total_words
End Function
How can I find sequential numbers in a cell, and replace them with a range?
For example:
change:
1,3,5,15,16,17,25,28,29,31...
to:
1,3,5,15-17,25,28-29,31...
The numbers are already sorted, i.e. in increasing order.
Thanks.
An interesting question that I wanted to look at do without looping through a sequence (which would need sorting first) checking for sequential builds
This function
forces the string to a range address
uses Union to group consecutive rows together
manipulates the string to remove the column identifier
loop wasn't necessary, shorter version!
Function NumOut(strIn As String) As String
Dim rng1 As Range
Set rng1 = Range("A" & Join(Split(Application.Trim([a1]), ", "), ",A"))
'force the range into areas rather than cells
Set rng1 = Union(rng1, rng1)
NumOut = Replace(Replace(Replace(rng1.Address, "$A$", vbNullstring), ": ", "-"), ",", ", ")
End Function
Thought I'd try an all-formulae solution using Microsoft365's LET() as a way to capture variables.
The below solution only counts 3+ consecutive numbers as ranges of numbers, not two.
Formula in B1:
=LET(X,FILTERXML("<t><s>"&SUBSTITUTE(A1,",","</s><s>")&"</s></t>","//s"),Y,TRANSPOSE(FILTERXML("<t><s>"&SUBSTITUTE(A1,",","</s><s>")&"</s></t>","//s[preceding::*[1]+1=.][following::*[1]-1=.]")),SUBSTITUTE(TEXTJOIN(",",,FILTERXML("<t><s>"&TEXTJOIN("</s><s>",,IF(MMULT(--(X=Y),SEQUENCE(COUNTA(Y),,,0)),"-",X))&"</s></t>","//s[.*0=0 or (.='-' and preceding::*[1]*0=0)]")),",-,","-"))
While the given range/area based answer is interesting, it suffers from a couple of flaws:
It is limited to an input string of 255 characters
It is relatively slow
Here's a basic array loop based method. It can handle long strings. In my testing it runs in about 1/3 the time. It also has the bonus of not requiring the input to be sorted
Function NumOut2(strIn As String) As String
Dim arrIn() As String
Dim arrBuckets() As Long
Dim i As Long
Dim InRange As Boolean
Dim mn As Long, mx As Long
arrIn = Split(strIn, ", ")
mn = arrIn(0)
mx = arrIn(0)
For i = 1 To UBound(arrIn)
If arrIn(i) < mn Then
mn = arrIn(i)
ElseIf arrIn(i) > mx Then
mx = arrIn(i)
End If
Next
ReDim arrBuckets(mn To mx)
For i = 0 To UBound(arrIn)
arrBuckets(arrIn(i)) = arrIn(i)
Next
NumOut2 = LBound(arrBuckets)
InRange = False
For i = LBound(arrBuckets) + 1 To UBound(arrBuckets)
If arrBuckets(i) > 0 Then
If arrBuckets(i) = arrBuckets(i - 1) + 1 Then
If InRange Then
Else
InRange = True
NumOut2 = NumOut2 & "-"
End If
Else
If InRange Then
NumOut2 = NumOut2 & arrBuckets(i - 1) & ", " & arrBuckets(i)
Else
NumOut2 = NumOut2 & ", " & arrBuckets(i)
End If
End If
Else
If InRange Then
NumOut2 = NumOut2 & arrBuckets(i - 1)
End If
InRange = False
End If
Next
End Function
I need to add brackets around the numbers in a string found in cells on my Excel worksheet.
For example, say I am given:
913/(300+525)
I need to get this in return:
[913]/([300]+[525])
The equations are fairly simple, should only have to deal with + - * / ( ) characters.
I attempted looping through the string character by character using the MID function but I can't get the loop(s) working correctly and end up getting a jumbled mess of random brackets and numbers back. I also considered using regular expressions but I've never used them before and have no idea if this would be a good application.
Please let me know if you need anything else. Thank you for your time!
They can be decently long. Here is another example:
I have:
(544+(1667+1668+1669+1670+1671+1672+1673)-1674)
But I need:
([544]+([1667]+[1668]+[1669]+[1670]+[1671]+[1672]+[1673])-[1674])
I just threw this together but it should work
Function generateBrackets(Equation As String) As String
Dim temp As String
Dim brackets As Boolean
Dim x 'If we're using Option Explicit, or just to be safe
For x = 1 To Len(Equation)
If Not IsNumeric(Mid(Equation, x, 1)) And brackets = False Then
temp = temp & Mid(Equation, x, 1)
ElseIf Not IsNumeric(Mid(Equation, x, 1)) And brackets = True Then
temp = temp & "]" & Mid(Equation, x, 1)
brackets = False
ElseIf IsNumeric(Mid(Equation, x, 1)) And brackets = False Then
temp = temp & "[" & Mid(Equation, x, 1)
brackets = True
ElseIf IsNumeric(Mid(Equation, x, 1)) And brackets = True Then
temp = temp & Mid(Equation, x, 1)
End If
Next x
generateBrackets = temp
End Function
Here is a way which caters for Decimal numbers.
'~~> Add here whatever operators your equation
'~~> is likely to have
Const delim As String = "+()-/"
Sub Sample()
Dim MyAr
Dim sSamp As String
sSamp = "(5.44+(16.67+1668+1669+1670+1671+1672+1673)-1674)"
MyAr = Split(GetNewString(sSamp))
For i = 0 To UBound(MyAr)
sSamp = Replace(sSamp, MyAr(i), "[" & MyAr(i) & "]")
Next i
Debug.Print sSamp
End Sub
Function GetNewString(s As String) As String
Dim sTemp As String
sTemp = s
For i = 1 To Len(delim)
sTemp = Replace(sTemp, Mid(delim, i, 1), " ")
Next i
Do While InStr(1, sTemp, " ")
sTemp = Replace(sTemp, " ", " ")
Loop
GetNewString = Trim(sTemp)
End Function
Input
"(5.44+(16.67+1668+1669+1670+1671+1672+1673)-1674)"
Output
([5.44]+([16.67]+[1668]+[1669]+[1670]+[1671]+[1672]+[1673])-[1674])