I have been using this code as a starting point: https://danwagner.co/how-to-transpose-horizontal-data-to-vertical-data-for-easy-pivot-tables/
One one of my cells Ax (x referring to the number), the content is ABCDEFGHI and I want to substring the cells every 2 characters, and the last set is 3 characters. Final result looks like:
AB CD EF GHI
At line 44, using the variable
varDetails = .Range(.Cells(lngIdx, 1), .Cells(lngIdx, 4))
and think that is where I need to modify the code. I am not fluent enough with VBA and need some help.
To split the data from your string you can use the following code
Sub SplitStringEveryTwoCharacters()
Dim arrayWithValuesByTwo() As String
Dim myString As String
'Just replace with your data
myString = "ABCDEFGHIJKLM"
'Resize
ReDim arrayWithValuesByTwo(Len(myString) - 1)
'For each 2 character in string
For i = 1 To Len(myString) Step 2
'Add in array
If (i <= Len(myString) - 1) Then
arrayWithValuesByTwo(i - 1) = Mid$(myString, i, 2)
End If
If (i = Len(myString)) Then
arrayWithValuesByTwo(i - 1) = Mid$(myString, i, 1)
End If
Next
End Sub
What you need to change
Here I have set my string into a variable with myString = "ABCDEFGHIJKLM" but you can easily change this and take it directly from a cell with something like myString = Range("A5").
You can access you data with arrayWithValuesByTwo(1) for example. Just loop through it to get all of the values.
Related
This question already has answers here:
TEXTJOIN for xl2010/xl2013 with criteria
(1 answer)
Excel How to compare 2 Column Ranges
(3 answers)
Concatenate column headers if value in rows below is non-blank
(1 answer)
Closed 4 years ago.
If I have different values in different cells, how can I join them together with a function with a delimiter of my own choosing (like "," or "| ", etc.).
For example:
So if you have:
A1: foo
A2: bar
A3: baz
You can type in A4:
=somefunction("",A1:A3)
And you will get in A4:
foo bar baz
Moreover, what if the inputs are results of an array function, like:
{foo, bar, bar}
Maybe a UDF would work?
I know in Microsoft Office 2016 there is the textjoin function, but it is only available for Office 365 subscribers. And this function cannot handle array inputs.
Try this user defined function. It is quite versatile. It will take for input hard-coded strings, single cell, cell ranges, arrays, or any mixture of them. Blanks will be ignored. See the photo for outputs.
Public Function TJoin(Sep As String, ParamArray TxtRng() As Variant) As String
On Error Resume Next
'Sep is the separator, set to "" if you don't want any separator. Separator must be string or single cell, not cell range
'TxtRng is the content you want to join. TxtRng can be string, single cell, cell range or array returned from an array function. Empty content will be ignored
Dim OutStr As String 'the output string
Dim i, j, k, l As Integer 'counters
Dim FinArr(), element As Variant 'the final array and a temporary element when transfering between the two arrays
'Go through each item of TxtRng(), depending on the item type, transform and put it into FinArray()
i = 0 'the counter for TxtRng
j = 0 'the counter for FinArr
k = 0: l = 0 'the counters for the case of array from Excel array formula
Do While i < UBound(TxtRng) + 1
If TypeName(TxtRng(i)) = "String" Then 'specified string like "t"
ReDim Preserve FinArr(0 To j)
FinArr(j) = "blah"
FinArr(j) = TxtRng(i)
j = j + 1
ElseIf TypeName(TxtRng(i)) = "Range" Then 'single cell or range of cell like A1, A1:A2
For Each element In TxtRng(i)
ReDim Preserve FinArr(0 To j)
FinArr(j) = element
j = j + 1
Next
ElseIf TypeName(TxtRng(i)) = "Variant()" Then 'array returned from an Excel array formula
For k = LBound(TxtRng(0), 1) To UBound(TxtRng(0), 1)
For l = LBound(TxtRng(0), 2) To UBound(TxtRng(0), 2)
ReDim Preserve FinArr(0 To j)
FinArr(j) = TxtRng(0)(k, l)
j = j + 1
Next
Next
Else
TJoin = CVErr(xlErrValue)
Exit Function
End If
i = i + 1
Loop
'Put each element of the new array into the join string
For i = LBound(FinArr) To UBound(FinArr)
If FinArr(i) <> "" Then 'Remove this line if you want to include empty strings
OutStr = OutStr & FinArr(i) & Sep
End If
Next
TJoin = Left(OutStr, Len(OutStr) - Len(Sep)) 'remove the ending separator
End Function
Screenshot:
Let's say your cells look like this:
A B
1 find good
2 apples for free
3 online now
4 at from this site:
5 https://www.example.com
You can put in some formulas like:
=tjoin(" ","please",$A$1,$A$3:$A$5)
=tjoin($A$6,$A$1:$A$5,"C1")
=tjoin(" ",IF(LEN($A$1:$A$5)>3,$A$1:$A$5,""))
=tjoin(" ",IF(LEN($A$1:$B$5)>3,$A$1:$B$5,""))
Your results will be:
please find online at https://www.example.com
find -- apples -- online -- at -- https://www.example.com -- C1
find apples online at https://www.example.com
find good apples for free online from this site: https://www.example.com
I am trying to write a VBA code ; I have 3-days experience as vba programmer. So trying my best based on my pascal programming experience.
find number in hexadecimal string from excel, check the position of number if its odd then replace the number with new number. If its not odd then continue searching for other occurrence within the same string.
I have 15,000 hexa strings where I need to recursively search. range(B1:B15000)
Example:
Hexa string - Cell B1 - 53706167686574746920616c6c9261676c696f2c206f6c696f20652070657065726f63696e692537
translates to text - Spaghetti all�aglio, olio e peperocini
i want to replace 92(�) with 65(e) but in hexa string you notice there are multiple occurrences of 92 number but only one 92 falls at odd position to be replaced.
In excel I tried following:
=IF(ISODD(IF(ISERROR(SEARCH(92,B5)),0,SEARCH(92,B5)))=TRUE,SUBSTITUTE(B5,92,"27"),"no 92")
This works only for first occurrence in cell,
tried modifying it to search further but no luck:
=IF(ISODD(IF(ISERROR(SEARCH(92,B6)),0,SEARCH(92,B6)))=TRUE,SUBSTITUTE(B6,92,"27"),IF(ISODD(IF(ISERROR(SEARCH(92,B6,SEARCH(92,B6)+1)),0,SEARCH(92,B6,SEARCH(92,B6)+1)))=TRUE,SUBSTITUTE(B6,92,"27"),"no 92"))
Any suggestions are welcome.
How about a small UDF, looking only at every second position?
Function replaceWhenAtOddPos(ByVal s As String, findStr As String, replaceStr As String)
replaceWhenAtOddPos = s
If Len(findStr) <> 2 Or Len(replaceStr) <> 2 Then Exit Function
Dim i As Long
For i = 1 To Len(s) Step 2
If Mid(s, i, 2) = findStr Then s = Left(s, i - 1) & replaceStr & Mid(s, i + 2)
Next i
replaceWhenAtOddPos = s
End function
call:
replaceWhenAtOddPos("53706167686574746920616c6c9261676c696f2c206f6c696f20652070657065726f63696e692537", "92", "65")
Please put the following UDF in a standard module:
Public Function replace_hex(str As String, srch As Integer, repl As Integer) As String
Dim pos As Integer
pos = InStr(pos + 1, str, CStr(srch))
Do Until pos = 0
If pos Mod 2 = 0 Then str = Left(str, pos - 1) & CStr(repl) & Mid(str, pos + 2)
pos = InStr(pos + 1, str, CStr(srch))
Loop
replace_hex = str
End Function
and call it in your worksheet like that:
=replace_hex(A1,92,65)
I have a script that takes the contents of a cell, and puts the first 2 characters of the cell into a string array. I need to later compare that string array to a string, but I can't seem to get that to work. Here's what I have:
For i = 2 To 600
colStr = Sheets("smartlist").Cells(i, "A").Value
If colStr <> "" Then
ReDim charArray(Len(colStr) - 1)
For j = 1 To Len(colStr)
charArray(j - 1) = Mid$(colStr, j, 1)
Next
strArray = LCase(charArray(0)) & LCase(charArray(1))
If CStr(Join(strArray)) = CStr(Join(pwArray)) Then
Now, I've tried:
If charArray = "ab"
If Join(charArray) = "ab"
If CStr(Join(charArray)) = "ab"
I'm pretty lost at this point. Any suggestions would be welcome!
Edit: added the whole function up until I get the 'Type mismatch'
You could use Join(charArray, "") - without "" it joins the elements with space so the result of your initial try was "a b"
Firstly, you really need to clarify what you're doing. You say that later you need to check what's in the string. If that is the case, then you don't need an array, you simply need another string...
Dim chars As String
chars = Left$(cellToTest, 2)
Later you can test more simply using the InStr function, like so...
Dim loc As Integer
loc = Instr(colStr, chars)
If loc > 0 Then
...
If you want to turn this into a function on your spreadsheet you can use the following in the cells as formulas...
=LEFT(A1, 2)
=SEARCH(A3, A1)
Here's a little screen shot of what I mean...
Situation
I have a UDF that works with a range that it is passed that is of variable height and 2 columns wide. The first row will contain text in column 1 and an empty column2. The remainder of column 1 will contain unsorted text with an associated value in the same row in column 2. I need to sort the data such that if some text in column 1 also appears in some other text in column.
Problem
My VBA skills are all self taught and mimimal at best. I remember a few decades ago in university we did bubble sorts and played with pointers, but I no longer remember how we achieved any of that. I do well reading code but creating is another story.
Objective
I need to generate a sort procedure that will produce unique text towards the bottom of the list. I'll try wording this another way. If text in column1 can be found within other text in column, that the original text need to be placed below the other text it can be found in along with its associated data in column 2. The text is case sensitive. Its not an ascending or descending sort.
I am not sure if its a restriction of the UDF or not, but the list does not need to be written back to excel, it just needs to be available for use in my UDF.
What I have
Public Function myFunk(rng As Range) As Variant
Dim x As Integer
Dim Datarange As Variant
Dim Equation As String
Dim VariablesLength As Integer
Dim Variable As String
Datarange = rng.Value
'insert something around here to get the list "rng or Datarange" sorted
'maybe up or down a line of code depending on how its being done.
Equation = Datarange(1, 1)
For x = 2 To UBound(Datarange, 1)
VariablesLength = Len(Datarange(x, 1)) - 1
Variable = Left$(Datarange(x, 1), VariablesLength)
Equation = Replace$(Equation, Variable, Datarange(x, 2))
Next x
myFunk = rng.Worksheet.Evaluate(Equation)
End Function
Example Data
Any help with this would be much appreciated. In that last example I should point out that the "=" is not part of the sort. I have a routine that strips that off the end of the string.
So in order to achieve what I was looking for I added a SWAP procedure and changed my code to look like this.
Public Function MyFunk(rng As Range) As Variant
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim datarange As Variant
Dim Equation As String
Dim VariablesLength As Integer
Dim Variable As String
'convert the selected range into an array
datarange = rng.Value
'verify selected range is of right shape/size
If UBound(datarange, 1) < 3 Or UBound(datarange, 2) <> 2 Then
MyFunk = CVErr(xlErrNA)
Exit Function
End If
'strip the equal sign off the end if its there
For x = 2 To UBound(datarange, 1)
If Right$(datarange(x, 1), 1) = "=" Then
datarange(x, 1) = Left$(datarange(x, 1), Len(datarange(x, 1)) - 1)
End If
Next x
'sort the array so that a variable does not get substituted into another variable
'do a top down swap and repeat? Could have sorted by length apparently.
For x = 2 To UBound(datarange, 1) - 1
For y = x + 1 To UBound(datarange, 1)
If InStr(1, datarange(y, 1), datarange(x, 1)) <> 0 Then
For z = LBound(datarange, 2) To UBound(datarange, 2)
Call swap(datarange(y, z), datarange(x, z))
Next z
y = UBound(datarange, 1)
x = x - 1
End If
Next y
Next x
'Set the Equation
Equation = datarange(1, 1)
'Replace the variables in the equation with values
For x = 2 To UBound(datarange, 1)
Equation = Replace$(Equation, datarange(x, 1), datarange(x, 2))
Next x
'rest of function here
End Function
Public Sub swap(A As Variant, B As Variant)
Dim Temp As Variant
Temp = A
A = B
B = Temp
End Sub
I sorted by checking to see if text would substitute into other text in the list. Byron Wall made a good point that I could have sorted based on text length. Since I had completed this before I saw the suggestion it did not get implemented though I think it may have been a simpler approach.
There's a list of cells that looks like [a-z ]* [1-9.]*. I want to split the numric part into the adjacent cell. How can I do this?
For another formula approach, you could try this to extract the numeric part of A1:
=MID(A1,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),255)
here's a vba snippet, in case this helps:
Dim s As String: s = "wergyuklwgh9235783850298"
Dim i As Long:
For i = 1 To Len(s)
If Mid(s, i, 1) Like "#" Then Exit For
Next
sLeft = Left(s, i - 1) ' now sLeft contains "wergyuklwgh"
sRght = Mid(s, i) ' now sRght contains "9235783850298"
could put this into a public function to make a little UDF, useable from the formula bar