I have data. Can be in list or just in rows and colums or anything really.
I have data entries like 10, 1010, 11, 111,2,201,3210, 300100 etc 6 numbers is max.
I would like to have data be sorted
10
1010
11
111
2
201
300100
3210
And not like
2
10
11
111
201
1010
3210
300100
Any neat way do to this. Can make it work with filters, so guess I need some code and cant figure it out.
Can make it work with filters if i add "." or something between every number. Then just add filter ?.?.?.?.?.? and sort accending. Havent even tried any code.
No VBA, but formulae; you could try:
Formula in B1:
=SORTBY(A1:A8,LEFT(A1:A8&"00000",6))
If you have the values in VBA, you can sort them alphabetically by forcing them to be strings and then using the < or > operator. Variant values and numbers will need to be converted to strings with CStr or an equivalent operation. You could also pass the values into a String variable, which will force it to become a String value.
Sub Example()
Const VALUES As String = "2 10 11 111 201 1010 3210 300100"
'Value Type is explicitly forced to be String
Dim ValueArr() As String
ValueArr = Split(VALUES, " ")
'Bubble Sort - Loop until no further changes are neccesary
Dim IsFinished As Boolean
While Not IsFinished
IsFinished = True
Dim i As Long
For i = LBound(ValueArr) To UBound(ValueArr) - 1
' The > operator is comparing strings alphabetically because the two values are String
If ValueArr(i) > ValueArr(i + 1) Then
'Swap
Dim tmp As String
tmp = ValueArr(i)
ValueArr(i) = ValueArr(i + 1)
ValueArr(i + 1) = tmp
IsFinished = False
End If
Next
Wend
Debug.Print Join(ValueArr, " ")
'Outputs "10 1010 11 111 2 201 300100 3210"
End Sub
Sort Delimited Cells
=LET(Data,A2:C14,delSplit,",",delJoin," ",
MAP(Data,LAMBDA(cell,
IFERROR(TEXTJOIN(delJoin,1,SORT(TRIM(TEXTSPLIT(cell,delSplit,,1)),,,1)),""))))
To create your own LAMBDA function, e.g. SortDelimited, in the Name Manager you could use the following...
=LAMBDA(Data,delSplit,delJoin,
MAP(Data,LAMBDA(cell,
IFERROR(TEXTJOIN(delJoin,1,SORT(TRIM(TEXTSPLIT(cell,delSplit)),,,1)),""))))
when you would use it anywhere in the workbook with e.g. the simple...
=SortDelimited(A2:C14,","," ")
Related
I want to divide numbers into unique sorted digits.
For example, the number can be 127425 and I would like 12457 as the result, meaning sorted and duplicate removed. I think the best is to explain with example:
+---------+--------+
| Number | Result |
+---------+--------+
| 127425 | 12457 |
+---------+--------+
| 2784425 | 24578 |
+---------+--------+
| 121 | 12 |
+---------+--------+
| 22222 | 2 |
+---------+--------+
| 9271 | 1279 |
+---------+--------+
The longest result can be only 123456789.
I don't think we need an array for that (no delimiter), but the use of substring could probably do the job. I just don't know where to begin, hence no code.
Any ideas are welcome. Thanks.
Another VBA routine to sort the unique elements of a cell, using an ArrayList:
Option Explicit
Function sortUniqueCellContents(S As String) As String
Dim arr As Object, I As Long, ch As String * 1
Set arr = CreateObject("System.Collections.ArrayList")
For I = 1 To Len(S)
ch = Mid(S, I)
If Not arr.contains(ch) Then arr.Add ch
Next I
arr.Sort
sortUniqueCellContents = Join(arr.toarray, "")
End Function
If you have a version of Excel that supports Dynaaic Arrays, then try this (for input in A2)
=CONCAT(SORT(UNIQUE(MID(A2,SEQUENCE(LEN(A2),1,1,1),1))))
How it works
SEQUENCE(LEN(A27),1,1,1) returns an array of numbers 1 .. the length of the input string
MID(A2, ... ,1)) uses that array to return a Spill range of the individual characters in the input string
UNIQUE( reduces that to a range of unique characters only
SORT sorts that range
CONCAT concatenates that range into a single string
Gearing off that to build a VBA function
Function UniqueDigits(s As String) As String
With Application.WorksheetFunction
UniqueDigits = Join(.Sort(.Unique(Split(Left$(StrConv(s, 64), Len(s) * 2 - 1), Chr(0)), 1), , , 1), "")
End With
End Function
Alternative to the newer dynamic array functions
Loving the above nice solutions it's always a challenge to think over additional approaches (via Byte array, Filter() and FilterXML() function):
Function UniqueDigits(ByVal txt) As String
Dim by() As Byte: by = txt
Dim digits: digits = Array(49, 50, 51, 52, 53, 54, 55, 56, 57, 48, 0) ' equalling Asc values
'a) create 1-based 1-dim array with digit positions
Dim tmp: tmp = Filter(Application.Match(by, digits, 0), 11, False)
'b) get uniques
tmp = Uniques(tmp)
'c) sort it (don't execute before getting uniques)
BubbleSort tmp
'd) return function result
UniqueDigits = Join(tmp, "")
End Function
Function Uniques(arr)
'Note: using FilterXML() available since vers. 2013+
Dim content As String ' replacing "10" referring to zero indexed as 10th digit
content = Replace("<t><s>" & Join(arr, "</s><s>") & "</s></t>", "10", "0")
arr = WorksheetFunction.FilterXML(content, "//s[not(preceding::*=.)]")
Uniques = Application.Transpose(arr)
End Function
Sub BubbleSort(arr)
Dim cnt As Long, nxt As Long, temp
For cnt = LBound(arr) To UBound(arr) - 1
For nxt = cnt + 1 To UBound(arr)
If arr(cnt) > arr(nxt) Then
temp = arr(cnt)
arr(cnt) = arr(nxt)
arr(nxt) = temp
End If
Next nxt
Next cnt
End Sub
Further hints :-) tl;dr
...explaining
a) how to transform a string to a digits array,
b) how to get uniques via FilterXML instead of a dictionary
c) (executing BubbleSort needs no further explanation).
ad a) the tricky way to get a pure digits array
Transforming a string of digits into an array of single characters may need some explanation.
A string (here txt) can assigned easily to a byte array via Dim by() As Byte: by = txt. (Note that classical characters would be represented in a byte array by a pair of Asc values, where the second value mostly
is 0; so digit 1 is represented by 49 and 0, 2 by 50 and 0 up to 9 by 57 and 0).
Digits are defined in a 1-based Asc value array from 1~>49 to 9~>57, followed by the 10th item 0~>48 and
eventually the Asc value 0 as 11th item related to each second byte pair.
Dim digits: digits = Array(49, 50, 51, 52, 53, 54, 55, 56, 57, 48, 0) ' equalling Asc values
Usually the Match() function searches for a specified item in order to get its relative position within an array (here digits) and would be executed by the following syntax: ``.
MATCH(lookup_value, lookup_array, [match_type])
where the lookup_value argument can be a value (number, text, or logical value) or a cell reference to a number, text, or logical value.
An undocumented feature is that instead searching e.g. 2 in the lookup_array digits via
Application.Match(2, digits,0) you can use the byte array as first argument serving as 1-based array pattern where VBA replaces the current Asc values by their position found within the digits array.
Application.Match(by, digits, 0)
Finally a negative filtering removes the companion Asc 0 values (11 plus argument False) via
Dim tmp: tmp = Filter(Application.Match(by, digits, 0), 11, False)
ad b) get uniques via FilterXML
Help reference for the WorksheetFunction.FilterXML method demands two string parameters
FilterXML(XMLContentString, XPathQueryString)
The first argument doesn't reference a file, but needs a valid ("wellformed") XML text string starting with a root node (DocumentElement) which is roughly comparable to a html structure starting with the enclosing pair of <html>...</html> tags.
So a wellformed content string representing e.g. number 121 could be:
<t>
<s>1</s>
<s>2</s>
<s>1</s>
</t>
The second argument (limited to 1024 characters) must be a valid XPath query string like the following find non-duplicates
"//s[not(preceding::*=.)]"
where the double slash // allows to find s nodes at any hierarchy level and under the condition that it is not
preceded by any nodes * with the same value content =.
Recommended readings
#RonRosenfeld is a pioneer author of numerous answers covering the FilterXML method, such as e.g. Split string cell....
#JvDV wrote a nearly encyclopaedic overview at Extract substrings from string using FilterXML.
Try the next function, please:
Function RemoveDuplSort(x As String) As String
Dim i As Long, j As Long, arr As Variant, temp As String
'Dim dict As New Scripting.Dictionary 'in case of reference to 'Microsoft Scripting Runtime,
'un-comment this line and comment the next one:
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To Len(x)
dict(Mid(x, i, 1)) = 1
Next i
arr = dict.Keys
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If arr(i) > arr(j) Then
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
RemoveDuplSort = Join(arr, "")
End Function
It can be called in this way:
Sub testRemoveDuplSort()
Dim x As String
x = "2784425" 'x = myLabel.Caption
Debug.Print RemoveDuplSort(x)
End Sub
If your number is in cell A3, then this one will return a string of unique numbers.
=CONCAT(SORT(UNIQUE(MID(A3,ROW(INDIRECT("1:"&LEN(A3))),1))))
I have up to 40 If/ElseIf conditions, where the code is:
If b = 1 Then
d = XXXX
ElseIf b = 2 Then
d = YYYY
ElseIf b = 3 Then
d = AAAA
ElseIf b = 40 Then
d = ZZZZ
End If
Is there a faster way of doing this, so that I don't have all the If/ElseIf conditions?
use an array
remember that arrays are by default 0 indexed, although you can override that and use any indexes you want when you redim the array.
Dim MyArray()
Dim ind As Long
MyArray = Array("XXXX","YYYY","AAAA","ZZZZ")
ind = 2
MsgBox MyArray(ind)
this will return the 3rd element or AAAA
just change ind to whatever element you want to return
Maybe use an array?
So arr(1) = XXXX and arr(2) = YYYY
That way you can
d = arr(b)
The best approach is to index through some array. In order to avoid creating the array each time you need it, you can declare it with the keyword Static. This way, indexing is very fast (especially for larger arrays). It's kind of a space-time tradeoff: the array keeps present in memory but indexing it is extremely fast.
In the following, I create a function that uses a static array to convert an index to a String. Note, however, that you might be interested in making it more dynamic by putting the strings in some hidden worksheet and load them from there.
Function myString(ByVal index As Long) As String
Static ar As Variant ' <-- static: filled once and keeps valid between function calls
If IsEmpty(ar) Then ar = Array("XXXX", "YYYY", "AAAA", "ZZZZ")
myString = ar(index - 1)
End Function
Sub TestIt()
Debug.Print myString(1)
Debug.Print myString(4)
End Sub
Dim PtDnr As Single
Dim TxDnr As Single
GrsDnr AsDim Single
Dim AmntDnr As Single
Dim Jour As Integer
Dim I As Integer
Jour = 7
PtDnr = 2256.03 'trhough 2 loops, the amount is correct
PtDnr = 0
For I = 35 To 40
PtDnr = PtDnr + Sheets(1).Cells(Jour, I)
Next
For I = 47 To 54
PtDnr = PtDnr + Sheets(1).Cells(Jour, I)
Next
TxDnr = Sheets(1).Cells(Jour, 32) ' This Cell has a Value of 167.11 "
NtDnr = Sheets(1).Cells(Jour, 33) ' This Cell Has a value of 2088.92
GrsDnr = TxDnr + NtDnr ' Give me 2256.03, this amount is correct
AmntDnr = GrsDnr - PtDnr ' Give me 2.441406E.04 wich is wrong
I checked the Cells one by one and make them with 12 decimals, after the first 2, all are at "0" ex: 167.110000000000
What I do wrong, I pass all night and tried several possibility but cannot figure out.
Thank you for your help
Jean
Try using data type Double instead of Single.
Although I don't understand how anyone is expected to know what is going wrong if we can not see the values that are getting fed into these calculations.
Good day everyone,
I am trying to find a smart solution of extracting 8 digits from a cell (unique ID). The problem here occurs that it might look like this:
112, 65478411, sale
746, id65478411, sale 12.50
999, 65478411
999, id65478411
Thats most of the cases, and probably all mentioned, so I basically need to find the 8 digits in the cell and extract them into different cell. Does anyone have any ideas? I though of eliminating the first characted, then check if the cell is starting with the id, eliminate it further but I understood that this is not the smart way..
Thank you for the insights.
Try this formula:
=--TEXT(LOOKUP(10^8,MID(SUBSTITUTE(A1," ","x"),ROW(INDIRECT("1:"&LEN(A1)-7)),8)+0),"00000000")
This will return the 8 digit number in the string.
To return just the text then:
=TEXT(LOOKUP(10^8,MID(SUBSTITUTE(A1," ","x"),ROW(INDIRECT("1:"&LEN(A1)-7)),8)+0),"00000000")
You can also write a UDF to accomplish this task, example below
Public Function GetMy8Digits(cell As Range)
Dim s As String
Dim i As Integer
Dim answer
Dim counter As Integer
'get cell value
s = cell.Value
'set the counter
counter = 0
'loop through the entire string
For i = 1 To Len(s)
'check to see if the character is a numeric one
If IsNumeric(Mid(s, i, 1)) = True Then
'add it to the answer
answer = answer + Mid(s, i, 1)
counter = counter + 1
'check to see if we have reached 8 digits
If counter = 8 Then
GetMy8Digits = answer
Exit Function
End If
Else
'was not numeric so reset counter and answer
counter = 0
answer = ""
End If
Next i
End Function
Here is an alternative:
=RIGHT(TRIM(MID(SUBSTITUTE(A1,",",REPT(" ",LEN(A1))),LEN(A4),LEN(A1))),8)
Replace all commas with spaces repeated the length of the string,
Then take the mid point starting from the length of the original string for the length of the string (ie second word in new string)
Trim out the spaces
take the right 8 chars to trim out any extra chars (like id)
I have a group of cells, the first of the string never changes, it is and always will (until the coder changes it) 20 characters (inc spaces).
I then want to extract the 3 numbers (and in some cases 2) from the remaining sequence.
The monthly cost is 2 silver, 1 copper and 40 iron.
The monthly cost is 1 silver, 94 copper and 40 iron.
The monthly cost is 1 silver and 75 copper.
The monthly cost is 8 silver and 40 copper.
The monthly cost is 1 silver.
The monthly cost is 99 silver, 99 copper and 99 iron.
The monthly cost is 1 gold.
In the sample above you can see that there is no set value after the first 20 chars.
1 or 99 silver
1 or 99 copper
0, 1 or 99 iron
I can't get a sequence that gets all the cells correct, I've tried the following:
=IF(J7<>1,(MID(TRIM(J7),FIND(" iron",TRIM(J7))-2,FIND(" iron",TRIM(J7))-FIND(" iron",TRIM(J7))+3)),"")
results in: #VALUE! (when no iron)
=TRIM(MID(J6,FIND(" silver",J6)-2,LEN(J6)-FIND(" silver",J6)-26))&TRIM(MID(J6,FIND(" copper",J6)-2,LEN(J6)-FIND(" copper",J6)-16))&TRIM(MID(J6,FIND(" iron",J6)-2,LEN(J6)-FIND(" iron",J6)-3))
results in: 1 s9440
=MID(J7,31,2-ISERR(MID(J7,21,1)+0))
results in: nd
If I & the cells as part of the calculation, they then don't calculate in the next mathematical step as I've had to allow for spaces in my code, in the case that there may be 2 digit numbers, not single.
=MID(J5,SEARCH(" silver",J5,1)-2,2)&MID(J5,SEARCH(" copper",J5,1)-2,2)&MID(J5,SEARCH(" iron",J5,1)-2,2)
results: 2 140
not: 2140
What I need to end up with is:
2140
19440
175
840
1
999999
Many thanks in advance.
This formula worked for me with your data, assuming text string in cell A1
=IFERROR(MID(A1,SEARCH("silver",A1)-3,2)+0,"")&IFERROR(MID(A1,SEARCH("copper",A1)-3,2)+0,"")&IFERROR(MID(A1,SEARCH("iron",A1)-3,2)+0,"")
I assume you don't want the value for "Gold"?
When it comes to pattern matching in strings, RegEx if often the way to go.
In Excel, this requires a VBA solution, using a reference to "Microsoft VBScript Regular Expresions 5.5" (you can go late bound if you prefer)
Here's a starter for your case, as a UDF
Use it as a formula like =GetValues(A1) assuming 1st raw data is in A1. Copy down for as many rows as required
This will extract up to 3 values from a string.
Function GetValues(r As Range) As Variant
Dim re As RegExp
Dim m As MatchCollection
Dim v As Variant
Dim i As Long
Set re = New RegExp
re.Pattern = "(\d+)\D+(\d+)\D+(\d+)"
If re.test(r.Value) Then
Set m = re.Execute(r.Value)
Else
re.Pattern = "(\d+)\D+(\d+)"
If re.test(r.Value) Then
Set m = re.Execute(r.Value)
Else
re.Pattern = "(\d+)"
If re.test(r.Value) Then
Set m = re.Execute(r.Value)
End If
End If
End If
If m Is Nothing Then
GetValues = vbNullString
Else
For i = 0 To m.Item(0).SubMatches.Count - 1
v = v & m.Item(0).SubMatches(i)
Next
GetValues = v
End If
End Function
Since you are just stripping digits you can use a short one-shot RegExp if you wanted the VBA route:
Function GetDigits(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "[^\d]+"
.Global = True
GetDigits = .Replace(strIn, vbNullString)
End With
End Function
Here's another method, using worksheet formulas, for returning all of the digits in a string. Harlan Grove put it out there many years ago.
First define a Name (with Workbook scope):
Seq
Refers to: =ROW(INDEX($1:$65536,1,1):INDEX($1:$65536,255,1))
Then, assuming your string is in A1, use the following array-entered formula. (Formula is entered by holding down ctrl+shift while hitting Enter. (If you do this correctly, Excel will place braces {...} around the formula.
=SUM(IF(ISNUMBER(1/(MID(A1,Seq,1)+1)),MID(A1,Seq,1)*10^MMULT(-(Seq<TRANSPOSE(Seq)),-ISNUMBER(1/(MID(A1,Seq,1)+1)))))