I've searched for this topic a lot but haven't found my exact issue. Also I seemingly can't figure out how to adapt the code samples for my use.
I'm trying to split a "file directory string" into substrings from right to left.
"C:\Users\Me\CustomerName\ProductName\2017\"
And split this from right to left, to
year
productname
customername
My attempts at using Split() to get it working, have always split it in the wrong places.
You mentioned you have tried with Split, so this is a good start:
Option Explicit
Public Sub TestMe()
Dim strFolderString As String
Dim arrFolderString As Variant
strFolderString = "C:\Users\Me\CustomerName\ProductName\2017\"
arrFolderString = Split(strFolderString, "\")
Debug.Print arrFolderString(UBound(arrFolderString) - 1)
Debug.Print arrFolderString(UBound(arrFolderString) - 2)
Debug.Print arrFolderString(UBound(arrFolderString) - 3)
End Sub
The idea is to use UBound as the right to left. I do not start from 0, because your string ends with \, thus the 0th position is empty.
Related
I have an issue with trim the string method NOT working completely I have reviewed MS Docs and looked of forums but with no luck... It's probably something simple or some other parameter is missing. This is just a sample,
Please note I need to pick up text before and after #, hence than I was planning to use # as a separator. Trim start # #, Trim End # #. I can't use The last Index or Replace per my understanding they have no direction. But perhaps I am misunderstood MS docs regards to trim Start and End as well...
thanks!
Dim str As String = "this is a #string"
Dim ext As String = str.TrimEnd("#")
MsgBox(ext)
ANSWER:
I found a solution for my problem, if you experience similar please see below:
1st: Trim end will NOT scan for the "character" from the Right as I originally thought it will just remove it from the right.... A weak function I would say:). IndexOf direction ID would be a very simple and helpful. Regards My answer was answered by Andrew, thanks!
Now there is another way around it if you try to split a SINGLE String INTO - QTY based on CHARACTER separation and populate fields accordingly.
Answer is ArrayList. Array List will ID each String so you can avoid repeated populations and etc. After you can use CASE or IF to populate accordingly.
Dim arrList As New ArrayList("this is a # string".Split("#"c)) ' Will build the list of your strings
Dim index As Integer = 1 ' this will help us index the strings 1st, 2nd and etc.
For Each part In arrList 'here we are going thru the list
Select Case index ' Here we are identifying which field we are populating
Case 1 '1st string(split)
MsgBox("1 " & arrList(0) & index) '1st string value left to SPLIT arrList(0).
Case 2 '2nd string(split)
MsgBox("2 " & arrList(1) & index) '2nd string value left to SPLIT arrList(1).
End Select
index += 1 'Here we adding one shift thru strings as we go
Next
Rather than:
Dim str As String = "this is a #string"
Dim ext As String = str.TrimEnd("#")
Try:
Dim str As String = "this is a #string"
Dim ext As String = str.Replace("#", "")
Dim str As String = "this is a #string"
Dim parts = str.Split("#"c)
For Each part in parts
Console.WriteLine($"|{part}|")
Next
Output:
|this is a |
|string|
Maybe there is a better way as we know there are multiple things to do the same thing.
The solution I used is below:
Dim arrList As New ArrayList("this is a # string".Split("#"c)) ' Will build the list of your strings
Dim index As Integer = 1 ' this will help us index the strings 1st, 2nd and etc.
For Each part In arrList 'here we are going thru the list
Select Case index ' Here we are identifying which field we are populating
Case 1 '1st string(split)
MsgBox("1 " & arrList(0) & index) '1st string value left to SPLIT arrList(0).
Case 2 '2nd string(split)
MsgBox("2 " & arrList(1) & index) '2nd string value left to SPLIT arrList(1).
End Select
index += 1 'Here we adding one shift thru strings as we go
Next
I have a workbook full of product codes and names. Contained within a form are various text boxes where a user can enter a code and its corresponding label will update with the name found in the workbook. Each text box runs the following sub when changed
Private Sub FindItem(x As Long)
Dim Name As Variant
Name = Application.VLookup(AddStockForm.Controls("Code" & x).Text, Sheet1.Range("B:C"), 2, False)
If IsError(Name) Then
AddStockForm.Controls("Name" & x).Caption = "Unknown Code"
Else
AddStockForm.Controls("Name" & x).Caption = Name
End If
End Sub
The sub takes the user input in the target box (e.g. Code1) and finds the corresponding name and writes it to the label (e.g. Name1). HOWEVER, the product codes are either strings, alphanumeric and plain text, OR numbers. For stupid reasons beyond my control, some codes have to be numbers, others have to contain letters.
This code works PERFECTLY for any code with a character in it (MYCODE or 500A) but not numbers, it writes "Unknown code" for any number, and they are in the lookup range. I have searched around stackoverflow and answers suggest declaring as variants, I've done this, even by assigning Controls().Text as a variant before using it in VLookup. I suspect the problem is
AddStockForm.Controls("Code" & x).Text
is a string. But I cannot convert to an INT because the user input might be a number or string.
Any ideas?
One thing you can do is to create a separate function which has the separate parts you want to do. In this instance, we are checking the input value first. If this is numerical we want to try doing the lookup as a string, then as a number if that fails. If the input value is not numerical we can go ahead and do the lookup as normal.
Public Function lookupStringOrInt(inputValue As Variant, tableArray As Range, colIndexNum As Long, Optional rangeLookup As Boolean) As Variant
If IsNumeric(inputValue) Then
lookupStringOrInt = Application.IfError(Application.VLookup(inputValue & "", tableArray, colIndexNum, rangeLookup), Application.VLookup(inputValue * 1, tableArray, colIndexNum, rangeLookup))
Else
lookupStringOrInt = Application.VLookup(inputValue, tableArray, colIndexNum, rangeLookup)
End If
End Function
You can then call this in your code with the line
name = lookupStringOrInt(AddStockForm.Controls("Code" & x) & "", Sheet1.Range("B:C"), 2, False)
If the value you are looking for does not exist, the function will return 'Error 2042'. You can choose to handle this however you like.
I've seen a lot of answers on how to sort email list by domain.
What I need is different.
All I have is a list of domains and sub-domains that need to be sorted properly.
As you may know, a domain hierarchy begins at the end, meaning first comes the .com, then the domain and then the suffix, e.g. "www"
So, I need to group them by relevance.
For example, I have the following domains:
www.somedomain.com
www.someotherdomain.co.uk
www.yetonemoredomain.org
sub.somedomain.com
1.somedomain.com
2.yetonemoredomain.org
3.someotherdomain.co.uk.
www2.yetonemoredomain.org
mail.someotherdomain.co.uk
Plain sort from A to Z will start from left to right, but I need it to be sorted from right to left, with the dot as a field separator.
I know a simple bash command can do it but I need it in Excel.
I was thinking about using "Text to columns" and separating by dots and then sorting columns as needed, but this may also cause some troubles with columns creation for 4th level domains and higher, such as x.y.x.somedomain.com.
Columns will be created from left to right, this means the .com may fall into different columns instead of being the rightest column.
I'm sure there must be a better way for doing this.
Thanks in advance for your help.
Ziv
This is probably a variation of one of the oldest algorithmic problems, known as Reverse the ordering of words in a string. The expected answer is the following - reverse twice - each word and then the whole sentence.
In your case, you need to do exactly this and then to sort.
Public Function ReverseMe(textToReverse As String, _
Optional delim As String = " ") As String
Dim test As String
Dim arr As Variant
Dim arr2 As Variant
Dim arrPart As Variant
Dim cnt As Long
arr = Split(textToReverse, delim)
ReDim arr2(UBound(arr))
For Each arrPart In arr
arr2(cnt) = StrReverse(arrPart)
cnt = cnt + 1
Next arrPart
ReverseMe = StrReverse(Join(arr2, delim))
End Function
Public Sub TestMe()
Debug.Print ReverseMe("veso.dosev.diri.rid", ".")
Debug.Print ReverseMe("VBA is the best language")
End Sub
You would get:
rid.diri.dosev.veso
language best the is VBA
Quick question that should be easy enough for a lot of you but I'm not well versed in VBA or code in general for that matter but I have a problem that only a Macro or piece of VBA code can resolve for me. I have to edit a large number of data entries in a spreadsheet, cell by cell.
So on to the question. Could you please show me an example or provide a complete macro for me to use to edit these cells?
The editing that I require is as follows:
I need to read each cell in the following range: B2 to Q383. A typical entry that needs to be examined and edited looks like this: 629.64\3.00\01:30
What needs to happen now is for everything to the left of the first "\" and everything to the right of the second "\" needs to be removed, including the "\", from each cell.
I've tried fiddling around with the LEFT and RIGHT commands and I can output the data that needs to be removed from the cells with something like this
=left(B11, Find("\", B11) - 1)
So what would be the delete command in a macro to target that data selection in that cell? Or how do I use a delete command with those parameters?
Thanks in advance for any advice or answers!
Not 100% sure what you're after - you say you want to remove the bits from the left and right, but the formula returns the bit on the left.
Anyway, here's 3 formula to do it:
Left: =TRIM(LEFT(B11,FIND("\",B11)-1))
Middle: =LEFT(MID(B11,FIND("\",B11)+1,LEN(B11)),FIND("\",MID(B11,FIND("\",B11)+1,LEN(B11)))-1)
Right: =MID(B11,FIND("\",SUBSTITUTE(B11,"\","~",1))+1,LEN(B11))
And three VBA functions to do it
(use these as you would formula - =leftbit(B11), or if you're looking for something other than backslashes - =leftbit(B11,"|") will find the I-bar as a divider. )
Public Function LeftBit(target As Range, Optional Divider As String = "\") As String
LeftBit = Trim(Left(target, InStr(target, Divider) - 1))
End Function
Public Function MiddleBit(target As Range, Optional Divider As String = "\") As String
Dim First As Long, Second As Long
First = InStr(target, Divider)
Second = InStr(First + 1, target, Divider)
MiddleBit = Mid(target, First + 1, Second - First - 1)
End Function
Public Function RightBit(target As Range, Optional Divider As String = "\") As String
RightBit = Right(target, Len(target) - InStrRev(target, Divider))
End Function
I'm looking into some legacy VB 6.0 code (an Access XP application) to solve a problem with a SQL statement by the Access app. I need to use replace single quotes with 2 single quotes for cases where a customer name has an apostrophe in the name (e.g. "Doctor's Surgery":
Replace(customerName, "'", "''")
Which will escape the single quote, so I get the valid SQL:
SELECT blah FROM blah WHERE customer = 'Doctor''s Surgery'
Unfortunately the Replace function causes an infinite loop and stack overflow, presumably because it replace function recursively converts each added quote with another 2 quotes. E.g. one quote is replaced by two, then that second quote is also replaced by two, and so on...
----------------EDIT---------------
I have noticed (thanks to posters) that the replace function used in this project is custom-written:
Public Function replace(ByVal StringToSearch As String, ByVal ToLookFor As String,
ByVal ToReplaceWith As String) As String
Dim found As Boolean
Dim position As Integer
Dim result As String
position = 0
position = InStr(StringToSearch, ToLookFor)
If position = 0 Then
found = False
replace = StringToSearch
Exit Function
Else
result = Left(StringToSearch, position - 1)
result = result & ToReplaceWith
result = result & Right(StringToSearch, Len(StringToSearch) - position - Len(ToLookFor) + 1)
result = replace(result, ToLookFor, ToReplaceWith)
End If
replace = result
End Function
Apparently, VB didn't always have a replace function of it's own. This implementation must be flawed. An going to follow folk's advice and remove it in favour of VB 6's implementation - if this doesn't work, I will write my own which works. Thanks everyone for your input!
Are you sure that it's not a proprietary implementation of the Replace function?
If so it can just be replaced by VB6's Replace.
I can't remember which version it appeared in (it wasn't in Vb3, but was in VB6) so if the original code base was vb3/4 it could be a hand coded version.
EDIT
I just saw your edit, I was Right!
Yes, you should be able to just remove that function, it'll then use the in build VB6 replace function.
We use an VB6 application that has the option of replacing ' with ` or removing them completely.
You could also walk through the letters, building a second string and inserting each ' as ''.
I just tried this in Access and it works fine (no stackoverflow):
Public Function ReplaceSingleQuote(tst As String) As String
ReplaceSingleQuote = Replace(tst, "'", "''")
End Function
Public Sub TestReplaceSingleQuote()
Debug.Print ReplaceSingleQuote("Doctor's Surgery")
End Sub