Inserting into an Excel VBA string - vba

In JAVA or C++, we can do something along the line of myString.insert(position, word). Is there a way we can do the same in Excel VBA's string? In my worksheet, I have a string looks like this: 01 / 01 / 995, I wants to insert a 1 into the year, so make it 01 / 01 / 1995.
Dim test_date As String
test_date = "01 / 25 / 995"
test_date = Mid(test_date, 1, 10) & "1" & Mid(test_date, 11, 4)
Is there another easier / more elegant way to do it?

I dont think there is a cleaner way of doing it so you could just wrap it up in a function. Another way of doing it would be with replace, but it's not any cleaner.
Function Insert(source As String, str As String, i As Integer) As String
Insert = Replace(source, tmp, str & Right(source, Len(source)-i))
End Function
or just modify what you have
Function Insert(source As String, str As String, i As Integer) As String
Insert = Mid(source, 1, i) & str & Mid(source, i+1, Len(source)-i)
End Function

This a version of the accepted answer, with added tests and working the way I would expect it to work:
Function Insert(original As String, added As String, pos As Long) As String
If pos < 1 Then pos = 1
If Len(original) < pos Then pos = Len(original) + 1
Insert = Mid(original, 1, pos - 1) _
& added _
& Mid(original, pos, Len(original) - pos + 1)
End Function
The tests pass:
Public Sub TestMe()
Debug.Print Insert("abcd", "ff", 0) = "ffabcd"
Debug.Print Insert("abcd", "ff", 1) = "ffabcd"
Debug.Print Insert("abcd", "ff", 2) = "affbcd"
Debug.Print Insert("abcd", "ff", 3) = "abffcd"
Debug.Print Insert("abcd", "ff", 4) = "abcffd"
Debug.Print Insert("abcd", "ff", 100) = "abcdff"
End Sub

Here is my fifty cents for this question.
First of all, I need to give credit to WONG, Ming Fung from wmfexel where I found this trick.
Unlike the VBA Replace function who asks for the String to replace, the Replace Worksheet function only asks for the position in the Origin String and the number of characters to overwrite.
By "abusing" this overwrite parameter, setting it to 0 allows us to add a given string at a specific position in an Orignin string by replacing 0 characters of it.
Here it how it works :
Dim test_date As String
test_date = "01 / 25 / 995"
test_date = Worksheetfunction.Replace(test_date, 11, 0, "1")
'Now test_date = "01 / 25 / 1995" as we added "1" at the 11th position in it
As you can see, it's really convenient and readable.
For those who are picky and thinks the name Replace is just confusing, Wrap it in an Insert function and you'll be all done ;).

Related

VBA convert unusual string to Date

I wanted to scrape data from yahoo as an excercise and then make a graph from it. I encountered a problem where when I scrape the dates, they are in a rather weird format:
?10? ?Aug?, ?2020
The question marks in the string are not realy question marks, they are some characters unknown to me, so I cannot remove them with Replace().
Then, when I try to use CDate() to convert this to Date format, the code crashed on "Type mismatch" error.
What I would need is to either find a way to find out what those characters are in order to remove them with Replace(), or to somehow convert even this weird format to a Date.
Alternatively, somehow improving the scraping procedure - so far I've been using for example
ie.document.getElementsByClassName("Py(10px) Ta(start) Pend(10px)")(3).innerText
to get the data - would also solve this problem.
If anyone wanted to try to scrape it, too an example url:
https://finance.yahoo.com/quote/LAC/history?period1=1469404800&period2=1627171200&interval=1d&filter=history&frequency=1d&includeAdjustedClose=true
An example of my code follows:
DateString = doc.getElementsByClassName("Py(10px) Ta(start) Pend(10px)")(j).innerText
LeftDateString = Clean_NonPrintableCharacters(DateString)
Worksheets("Stock_data").Range("A2").Value = CDate(LeftDateString)
With regexp:
Function GetDate(txt)
' set a reference to 'Microsoft VBScript Regular Expression 5.5' in Tools->References VBE menu
Dim re As New RegExp, retval(0 To 2), patterns, i, result
patterns = Array("\b\d\d\b", "\b[a-zA-Z]+\b", "\b\d{4}\b")
For i = 0 To 2
re.Pattern = patterns(i)
Set result = re.Execute(txt)
If result Is Nothing Then Exit Function 'If no day, month or year is found, GetDate() returns ""
retval(i) = result(0)
Next
GetDate = Join(retval)
End Function
Sub Usage()
For Each txt In Array("?10? ?Aug?, ?2020", "Jul 13, 2020", "2021, March?, 18?")
Debug.Print GetDate(txt)
Next
End Sub
Prints:
10 Aug 2020
13 Jul 2020
18 March 2021
Edit 2
Function GetDate2(txt)
' set a reference to 'Microsoft VBScript Regular Expression 5.5' in Tools->References VBE menu
Static re As RegExp, months As Collection
Dim result
If re Is Nothing Then 'do it once
Set re = New RegExp
re.Pattern = "[^a-zA-Z0-9]"
re.Global = True
Set months = New Collection
cnt = 1
For Each m In Split("jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec", ",")
months.Add cnt, m
cnt = cnt + 1
Next
End If
result = Split(WorksheetFunction.Trim(re.Replace(txt, " ")))
For i = 0 To UBound(result)
If Not IsNumeric(result(i)) Then
result(i) = Left(LCase(result(i)), 3)
On Error Resume Next
result(i) = months(result(i))
On Error GoTo 0
End If
Next
result = Join(result)
If IsDate(result) Then GetDate2 = CDate(result)
End Function
Sub Usage2()
For Each txt In Array("?10? ?Aug?, ?2020", "Jul 13, 2020", "2021, March?, 18?", _
"01/12/2021", "04.18.2020", "15 10 20")
Debug.Print GetDate2(txt)
Next
End Sub
Prints:
10.08.2020
13.07.2020
18.03.2021
01.12.2021
18.04.2020
15.10.2020
Note. The order of the dd and mm may be vary
I would use something like so. I've used your ? as question marks for this example, i assumed they were all the same wierd character. This outputs
10 Aug 2020
Sub d()
Dim d As String
d = "?10? ?Aug?, ?2020"
d = Replace(Replace(d, Chr(Asc(Left(d, 1))), vbNullString), ",", vbNullString)
Debug.Print d
End Sub
you could loop though each char in the string and check its ascii values and create your date string from that. Example
Sub GetTheDate(sDate As String)
'97 - 122: lower case Ascii values
Dim i As Integer
Dim strDate As String
'loop through each char
For i = 1 To Len(sDate)
'check to see if it is numeric
If IsNumeric(Mid(sDate, i, 1)) Then
'numeric so add it to the string
strDate = strDate & Mid(sDate, i, 1)
Else
'check to see if it is a char a-z
If Asc(LCase(Mid(sDate, i, 1))) >= 97 And Asc(LCase(Mid(sDate, i, 1))) <= 122 Then
'it is an a char from a-z so add it to string
strDate = strDate & Mid(sDate, i, 1)
Else
'chekc for a space and add a comma - this sets up being able to use cdate()
If Mid(sDate, i, 1) = " " Then
strDate = strDate & ","
End If
End If
End If
Next i
'convert it and print it
Debug.Print CDate(strDate)
End Sub

How to specify a format when converting String to Date

I know I can use Format() when converting a date into a string. And Cells.NumberFormat to change the display text of a date.
I'm trying to go the opposite direction. I have a string like "231211" or "08AUG11" and a corresponding date format like "YYMMDD" or "DDMMMYY" and I just need to convert the string based on the format. I already have a way to find the correct format of each string, I just need to do the conversion.
I can't seem to find the right function/method to do what I'm asking. DateTime.ParseExact doesn't seem to exist in Excel 2007, even after I added mscorlib.dll as a reference.
Is there an alternative I can use? Or how do I get DateTime.ParseExact to work properly in Excel 2007?
Since the string is not always the same length and there are about 30 different formats, it's quite annoying to conditionally split the string and interpret the substrings individually. I would love to be able to just parse the date based on the format.
here is a start to create your own function:
Function dateParser(str As String, fmt As String) As Date
If Len(str) <> Len(fmt) Then Exit Function
Dim dy As Long
Dim mnth As String
Dim yr As Long
Dim mnthnm As Long
Dim i As Long
For i = 1 To Len(str)
If UCase(Mid(fmt, i, 1)) = "D" Then
dy = dy * 10 + CLng(Mid(str, i, 1))
ElseIf UCase(Mid(fmt, i, 1)) = "Y" Then
yr = yr * 10 + CLng(Mid(str, i, 1))
ElseIf UCase(Mid(fmt, i, 1)) = "M" Then
mnth = mnth & Mid(str, i, 1)
End If
Next i
If IsNumeric(mnth) Then
mnthnm = CLng(mnth)
Else
mnthnm = Month(CDate("01 " & mnth & " 2020"))
End If
dateParser = DateSerial(yr, mnthnm, dy)
End Function
Used like:
Sub test()
Dim str As String
str = "08AUG11"
Dim fmt As String
fmt = "DDMMMYY"
Dim x As Date
x = dateParser(str, fmt)
debug.print x
End Sub

vba excel - Find and replace on condition + within same cell multiple occurance

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)

Identify Capital Letter in grouped words and insert a comma and space

I am working on a task where I have to copy/paste the content from website into excel.
But the problem is when I copy/paste the content in excel, it appears like this :
Los AngelesNew YorkSilicon Valley
Consumer InternetMobileB2BEnterprise SoftwareE-CommerceMarketplacesSocial
Let s call Los Angeles an item which is merged with another item New York and I want to separate these items so that information is readable like this:
Los Angeles, New York, Silicon Valley
Consumer Internet, Mobile, B2B, Enterprise Software, E-Commerce, Marketplaces, Social
When I noticed I actually realized that on website (due to some technical reason) I was unable to copy the comma between items and therefore every other item was merged with a capital letter with previous item.
Now please help me know is there an intelligent way to solve this problem because there are hundred of entries. What I see is this is how this problem can be solved:
Identify a capital letter which is not after a space and has small letter previous to it.
Insert a comma and space at that place and continue with the remaining string.
Please feel free to elaborate if this won't work and if there is an alternative solution. VBA code/ Excel Formula - anything that can help me automate it. Thanks.
With "B2B" it would be a bit tougher, but it works pretty well with the others:
Public Sub TestMe()
Debug.Print insert_a_space("Los AngelesNew YorkSilicon Valley")
Debug.Print insert_a_space("Consumer InternetMobileB2BEnterprise SoftwareE-CommerceMarketplacesSocial")
End Sub
Public Function insert_a_space(my_str As String)
Dim my_char As String
Dim l_counter As Long
Dim str_result As String
For l_counter = 1 To Len(my_str)
my_char = Mid(my_str, l_counter, 1)
If Asc(my_char) >= 65 And Asc(my_char) <= 90 Then
If l_counter > 1 Then
If Asc(Mid(my_str, (l_counter - 1), 1)) <> 32 And _
Asc(Mid(my_str, (l_counter - 1), 1)) <> 45 Then
str_result = str_result & ", "
End If
End If
End If
str_result = str_result & my_char
Next l_counter
insert_a_space = str_result
End Function
The logic is that you run TestMe. Or use as an Excel function insert_a_space and then give the string. The function looks for big letters (between 65 and 90 asc) and if there is no space or - before the big letter (asc 32) and (asc 45), it writes a comma with a space to the answer.
Edit:
Workaround SaaS and B2B
The idea is to introduce an escape symbol. Thus, whenever we see "\" we ignore it. This escape symbol is introduced through str_replace_me and should be explicitly written for which options it is.
Public Sub TestMe()
Dim str_1 As String
Dim str_2 As String
str_1 = "Los AngelesNew YorkSilicon Valley"
str_2 = "Consumer InternetMobileB2BEnterprise SoftwareE-CommerceMarketplacesSocialSaaS"
Debug.Print insert_a_space(str_replace_me(str_1))
Debug.Print insert_a_space(str_replace_me(str_2))
End Sub
Public Function str_replace_me(my_str As String) As String
str_replace_me = Replace(my_str, "SaaS", "Saa\S")
str_replace_me = Replace(str_replace_me, "B2B", "B2\B")
End Function
Public Function insert_a_space(my_str As String)
Dim my_char As String
Dim l_counter As Long
Dim str_result As String
For l_counter = 1 To Len(my_str)
my_char = Mid(my_str, l_counter, 1)
If Asc(my_char) >= 65 And Asc(my_char) <= 90 Then
If l_counter > 1 Then
If Asc(Mid(my_str, (l_counter - 1), 1)) <> 32 And _
Asc(Mid(my_str, (l_counter - 1), 1)) <> 45 And _
Asc(Mid(my_str, (l_counter - 1), 1)) <> 92 Then
str_result = str_result & ", "
End If
End If
End If
str_result = str_result & my_char
Next l_counter
str_result = Replace(str_result, "\", "")
insert_a_space = str_result
End Function
Please paste this code in VBA module.
Function AddSpaces(pValue As String) As String
Dim xOut As String
xOut = VBA.Left(pValue, 1)
For i = 2 To VBA.Len(pValue)
xAsc = VBA.Asc(VBA.Mid(pValue, i, 1))
If xAsc >= 65 And xAsc <= 90 Then
xOut = xOut & "," & " " & VBA.Mid(pValue, i, 1)
Else
xOut = xOut & VBA.Mid(pValue, i, 1)
End If
Next
AddSpaces = xOut
End Function
After that go to your spreadsheet and enter this formula =addspaces(A1)
Copy the formula to all the cells that you want to change.
You can copy the content from the website and paste the same into a notepad. Then copy the content from the notepad and paste it into the Excel.

How to convert bit number to digit

I'm working to create an Excel macro using VBA to convert bit strings to numbers. They are not binary numbers, each '1' stands for it's own number.
e.g: 1100000000000000000010001
from the left, the first bit represents "1", the second bit represents "2", third bit represents "0", and so on. The total quantity of bits in each string is 25.
I want VBA to convert it and show results like so: 1, 2, 21, 25.
I tried using Text to Columns but was not successful.
Try something like this:
Sub Execute()
Dim buff() As String
Dim i As Integer, total As Double
buff = Split(StrConv(<theString>, vbUnicode), Chr$(0))
total = 0
For i = 0 To UBound(buff)
Debug.Print (buff(i))
'total = total + buff(i) * ??
Next i
End Sub
Consider:
Public Function BitPicker(sIn As String) As String
For i = 1 To Len(sIn)
If Mid(sIn, i, 1) = 1 Then
BitPicker = BitPicker & i & ","
End If
Next
BitPicker = Mid(BitPicker, 1, Len(BitPicker) - 1)
End Function
Another non-VBA solution, based on the OP' initial approach and with a layout designed to facilitate multiple 'conversions' (ie copy formulae down to suit):
Does this have to be VBA? Give a data setup like this:
The formula in cell B4 and copied down to B33 is:
=IF(ROWS(B$3:B3)>LEN($B$1)-LEN(SUBSTITUTE($B$1,"1","")),"",FIND("#",SUBSTITUTE($B$1,"1","#",ROWS(B$3:B3))))
The formula cells are formatted as General and the the Bit String cell (B1) is formatted as Text.
Try this:
Function ConvertMyRange(Rng As Range) As String
Dim MyString As String
MyString = Rng.Text
Dim OutPutString As String
For i = 1 To Len(MyString)
If Mid(MyString, i, 1) = "1" Then OutPutString = OutPutString & ", " & i
Next i
' Get rid of first ", " that was added in the loop
If Len(OutPutString) > 0 Then
OutPutString = Mid(OutPutString, 2)
End If
ConvertMyRange = OutPutString
End Function
For your input, the output is 1, 2, 21, 25