I made a userform which contains two textboxes. When I click the button, the two textboxes are unified in a single cell.
Dim Dados As String, DadosLen As Integer
With Me
Dados = .caixanfnum.Text & Chr(10) & .caixanfdata.Text
DadosLen = Len(.caixanfnum.Text)
End With
With Sheets("-").Cells(linha, 4)
.Font.Bold = False
.WrapText = True
.Value = Dados
.Characters(1, DadosLen).Font.Bold = True
End With
I want to bring it back to the userform (I'm trying to make a search tool).
How do I split this cell to fill the two textboxes?
For your problem the split function should be the best solution, but you need a delimiter. The delimiter is the character at wich position the string (value of the cell) will be splitted.
splitted_text = Split(Sheets("-").Cells(linha, 4).Value, "your character")
This will return an array. You get the parts of the splitted string with splitted_text(0) and splitted_text(1)
Another way wich could work are the left, mid and right functions.
This will only work if the strings you are combining in the cell have a constant length.
first_string=Left(Sheets("-").Cells(linha, 4).Value, 5)
second_string=Right(Sheets("-").Cells(linha, 4).Value, 5)
middle_string=Mid(Sheets("-").Cells(linha, 4).Value, 5,5)
First string will return the 5 left chars of the string in the cell, second_string will return the 5 last chars in the string. The middle_string will give you five chars starting at the 5. position in the string, so it will give you char 5-9.
You could,
Use the Split function, or
Use the Left, Right, and Len Functions
1. Split
Dim TempSplit AS Variant
TempSplit = Split(Sheets("-").Cells(linha, 4), Chr(10))
.caixanfnum.Text = TempSplit(0)
.caixanfdata.Text = TempSplit(1)
This would be the most direct way to do this and is my preferred way.
If there are other instances of Chr(10) in your text box values however;
2. Using Left, Right and Len Functions (ft. Mid)
Something like;
.caixanfnum.Text = Left(Sheets("-").Cells(linha, 4), DadosLen)
.caixanfdata.Text = Right(Sheets("-").Cells(linha, 4), Len(Sheets("-").Cells(linha, 4)) - DadosLen)
Altenatively to the Right function you could use Mid instead:
Mid(Sheets("-").Cells(linha, 4), DadosLen + 2
Less preferred by me but will work.
Related
How can I generate a string using vba that lets certain characters line up. As an example, lets say the strings generated over two rows are as follows:
"96 x $219.00 = $21,024.00"
"-8 x 45.00 = -360.00"
I want spaces added to the left of the rightmost number to have the "=" signs line up.
I also want spaces added to the left of the middle number to have the "x" character line up.
These strings are generated from a vba function.
I'm restricted to using Times-Roman Size 8 (company requirement, no negotiating)
Also, the string is to be right justified, in case someone is concerned.
After trying to extract the character width using Columns.ColumnWidth and comparing the widths of repeating a character say 10 and then 11 times (I tried other sets of numbers than these), then building a function to break down a string into characters and sum them, padding as described, the characters still don't line up. There should be a way to do this in vba. There are too many tables to fix by hand. Previous posting discussing just padding characters, fail to address how they are displayed.
Aligning text by inserting spaces is a terrible idea (word processing 101). Plus it is modifying the data, and as a user I would complain if I enter a=b into a cell and all of a sudden it is a=b.
Aligning text for a non-proportional font by adding spaces is impossible. You can only have a "best attempt" which approximately aligns them.
There is no build-in function in Excel (or VBA) to achieve this.
So, I did the following just for fun. Take it or leave it.
(1) There is no build in function for the text width of a string in VBA. If you google around, you can find different attempts, but one suggestion is rather easy to understand: Put a label on a user form, format it to the font you are interested in (eg Times New Roman, 8pt, Non-Bold, Non-Italic) and set properties AutoSize = True and .WordWrap = False.
When assigning any text to this label, it changes its size and you can read the width of it. Now this doesn't return the exact width of the text as the label uses some extra pixels to the left and right - but for our purposes we can ignore that.
So create a userform and put a label on it. Don't worry, you don't need to show the form, the resize of the label will be done even if the form is not displayed.
Now put the following code into a regular module:
Function GetTextWidth(s As String) As Double
Static f As UserForm1
If f Is Nothing Then Set f = New UserForm1
With f.Label1
.Font.Name = "Times New Roman"
.Font.Size = 8
.Font.Italic = False
.Font.Bold = False
.AutoSize = True
.WordWrap = False
.Caption = s
GetTextWidth = .Width
End With
End Function
(2)
Now we need to loop over all data (all cells of your range), split the text into the part left of the equation sign and the part right of it using split, calculate the word length for the left part and remember the length of the widest string.
(3)
Now we loop another time over all the data, again split the text, take the left part and add spaces to the left until the width is larger (or equal) than the max length we just calculated. If we reach the point, we check if this "nearer" to the max length or if we should go for one space left.
Code for Step 2 and 3:
Sub alignTextrange(r As Range, Optional alignChar As String = "=")
Const SpacesAroundAlignChar = 1
' First: Find widest string to the left of alignChar
Dim maxWidth As Double, currWidth As Double, prevWidth As Double
Dim leftWord As String
Dim cell As Range, tokens() As String
For Each cell In r
tokens = Split(cell.Value, alignChar)
If UBound(tokens) = 1 Then ' 2 pieces (like a = b)
leftWord = Trim(tokens(0))
currWidth = GetTextWidth(leftWord)
If currWidth > maxWidth Then maxWidth = currWidth
End If
Next
Debug.Print "Max: " & maxWidth
If maxWidth = 0 Then Exit Sub
' And now: Align all other cells to the one with the widest left string
For Each cell In r
tokens = Split(cell.Value, alignChar)
If UBound(tokens) = 1 Then ' 2 pieces (like a = b)
leftWord = Trim(tokens(0))
prevWidth = GetTextWidth(leftWord)
Dim i As Long
For i = 1 To 100
currWidth = GetTextWidth(Space(i) & leftWord)
Dim spacesNeeded As Long
If currWidth >= maxWidth Then
If maxWidth - prevWidth < currWidth - maxWidth Then
spacesNeeded = i - 1
Else
spacesNeeded = i
End If
cell = Space(spacesNeeded) & leftWord _
& Space(SpacesAroundAlignChar) & alignChar _
& Space(SpacesAroundAlignChar) & Trim(tokens(1))
Exit For
End If
prevWidth = currWidth
Next
End If
Next
End Sub
Of course there is room for improvement, like reading/writing the data into an array or to precalculate the width of several spaces, this should only show the rabbit hole you need to go down.
If this is not good enough then your only option is to go for spaces with a smaller font, but then it gets much more complicated. Or convince your bossed to get rid of this ugly font (or look for a new job).
(alignted is obviously a typo, too lazy to correct in my sheet and redo the screenshots).
I want to separate a character string using the special characters in that string as cutting lines. After each division the next group of strings should be copied in the next column. The picture below shows how it should work.
My first approach doesn't work and maybe it's too complicated. Is there a simple solution to this task?
Sub SeparateString()
Dim i, j, k, counterA, counterB As Integer
Dim str1, str2 As String
Const Sonderz As String = "^!§$%&/()=?`*'_:;°,.-#+´ß}][{³²"
For i = 1 To Worksheets("Tabelle1").Range("A1").End(xlDown).Row
counterA = 0
For j = 1 To Len(Worksheets("Tabelle1").Range("A" & i))
counterB = 0
For k = 1 To Len(Sonderz)
If Mid(Worksheets("Tabelle1").Range("A" & i), j, 1) = Mid(Sonderz, k, 1) Then
counterA = counterA + 1
End If
If Mid(Worksheets("Tabelle1").Range("A" & i), j, 1) <> Mid(Sonderz, k, 1) And counterA = 0 And counterB = 0 Then
Worksheets("Tabelle1").Range("B" & i) = Worksheets("Tabelle1").Range("B" & i) & Mid(Worksheets("Tabelle1").Range("A" & i), j, 1)
counterB = counterB + 1
End If
Next k
Next j
Next i
End Sub
If you are interested and you do have access to Microsoft 365's dynamic arrays:
Formula in B1:
=LET(X,MID(A1,SEQUENCE(LEN(A1)),1),TRANSPOSE(FILTERXML(CONCAT("<t><s>",IF(ISNUMBER(FIND(X,"^!§$%&/()=?`*'_:;°,.-#+´ß}][{³²")),"</s><s>",X),"</s></t>"),"//s")))
Or nest a SUBSTITUTE() if you need to return string variables:
=LET(X,MID(A1,SEQUENCE(LEN(A1)),1),TRANSPOSE(SUBSTITUTE(FILTERXML(CONCAT("<t><s>'",IF(ISNUMBER(FIND(X,"^!§$%&/()=?`*'_:;°,.-#+´ß}][{³²")),"</s><s>'",X),"</s></t>"),"//s"),"'","")))
If VBA is a must, you could think about a regular expression to replace all the characters from a certain class with a uniform delimiter to use Split() on:
Sub Test()
Dim s As String: s = "CD!02?WX12EF"
Dim arr() As String
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "[!§$%&\/()=?`*'_:;°,.#+´ß}\][{³²^-]"
arr = Split(.Replace(s, "!"), "!")
End With
For Each el In arr
Debug.Print el
Next
End Sub
The caret has been moved from being the 1st character to any but the first to prevent a negated-character class; also the hyphen has been moved to the back to prevent an array-construct of characters. Funny enough, if you actually want to be less verbose you could throw these character in a more condense class [!#-/:;?[]-`{}§=°´ß³²].
Assuming the first data is in cell A2,
I would go with the simple use of find() with left() mid() and right()
=left(A2,find("!",A2,1)-1)
then:
=mid(A2,find("!",A2,1)+1,find("?",A2,1)-find("!",A2,1)-1)
and:
=right(A2,len(A2)-find("?",A2,1))
Tested and working with one correction done.
You can also do this in Power Query which has a command to split by ANY delimiter.
In the code below, I generate a list of all possible special characters defined as characters NOT in the set of A..Za..z0..9 and you can easily add to that list by editing the code if you want to include other characters in the permitted list.
Edit: If you only have a few special characters, you can just hard-code the list, eg {"!","?"} instead of using List.Generate, but in your question you did not necessarily restrict the list of special characters, even though those are the only two showing in your examples
To use Power Query:
Select some cell in your Data Table
Data => Get&Transform => from Table/Range
When the PQ Editor opens: Home => Advanced Editor
Make note of the Table Name in Line 2
Paste the M Code below in place of what you see
Change the Table name in line 2 back to what was generated originally.
Read the comments and explore the Applied Steps to understand the algorithm
let
//change Table name in next line to reflect actual table name
Source = Excel.CurrentWorkbook(){[Name="Table15"]}[Content],
#"Changed Type" = Table.TransformColumnTypes(Source,{{"Source", type text}}),
//Generate list of "special characters" for splitting
//the List.Contains function contains the non-special characters
splitterList = List.RemoveNulls(
List.Generate(()=>0,
each _ <= 255,
each _ +1,
each if List.Contains({"A".."Z","a".."z","0".."9"}, Character.FromNumber(_)) then null else Character.FromNumber(_))),
splitIt = Table.SplitColumn(#"Changed Type", "Source",
Splitter.SplitTextByAnyDelimiter(splitterList))
in
splitIt
I am working on a macro for a document-tracking sheet at work. I use a button that prompts the user to enter in the document number and I'd like to specify a default number based on the following numbering convention. The first two characters of the document number are the latter two year digits (15 in this case), then there is a "-" followed by a five digit serialization.
My current code looks at the last-entered document and increments those last 5 characters, but chops off any leading zeroes, which I want to keep. This is an extraction of the code to generate this default number (assuming the variable "prevNCRF" is the previous document name found in the doc):
Sub codeChunkTester()
Dim prevNCRF, defNCRFNum As String
Dim NCRFNumAr() As String
'pretend like we found this in the sheet.
prevNCRF = "15-00100"
'split the string into "15" and "00100" and throw those into an array.
NCRFNumAr() = Split(prevNCRF, "-")
'reconstruct the number by reusing the first part and dash, then converting
'the "00100" to a number with Val(), adding 1, then back to a string with CStr().
defNCRFNum = NCRFNumAr(0) & "-" & CStr(Val(NCRFNumAr(1)) + 1)
'message box shows "15-101" rather than "15-00101" as I had hoped.
MsgBox (defNCRFNum)
End Sub
So can anyone help me preserve those zeroes? I suppose I could include a loop that checks the length of the string and adds a leading zero until there are 5 characters, but perhaps there's a better way...
Converting "00100" to a Double using Val turned it into 100, so CStr(100) returns "100" as it should.
You need to format the string to what you want it to look like:
defNCRFNum = NCRFNumAr(0) & "-" & Format(Val(NCRFNumAr(1)) + 1, "00000")
If you need to parameterize the length of the string, you can use the String function to generate the format string:
Const digits As Integer = 5
Dim formatString As String
formatString = String(digits, "0")
defNCRFNum = NCRFNumAr(0) & "-" & Format(Val(NCRFNumAr(1)) + 1, formatString)
Here is that loop solution I mentioned above. If anyone's got something better, I'm all ears!
prevNCRF = "15-00100"
NCRFNumAr() = Split(prevNCRF, "-")
zeroAdder = CStr(Val(NCRFNumAr(1)) + 1)
'loop: everytime the zeroAdder string is not 5 characters long,
'put a zero in front of it.
Do Until Len(zeroAdder) = 5
zeroAdder = "0" & zeroAdder
Loop
defNCRFNum = NCRFNumAr(0) & "-" & zeroAdder
MsgBox (defNCRFNum)
defNCRFNum = NCRFNumAr(0) & "-" & Format(CStr(Val(NCRFNumAr(1)) + 1), String(Len(NCRFNumAr(1)), "0"))
I'm trying to compare strings in a macro and the data isn't always entered consistently. The difference comes down to the amount of leading white space (ie " test" vs. "test" vs. " test")
For my macro the three strings in the example should be equivalent. However I can't use Replace, as any spaces in the middle of the string (ex. "test one two three") should be retained. I had thought that was what Trim was supposed to do (as well as removing all trailing spaces). But when I use Trim on the strings, I don't see a difference, and I'm definitely left with white space at the front of the string.
So A) What does Trim really do in VBA? B) Is there a built in function for what I'm trying to do, or will I just need to write a function?
Thanks!
So as Gary's Student aluded to, the character wasn't 32. It was in fact 160. Now me being the simple man I am, white space is white space. So in line with that view I created the following function that will remove ALL Unicode characters that don't actual display to the human eye (i.e. non-special character, non-alphanumeric). That function is below:
Function TrueTrim(v As String) As String
Dim out As String
Dim bad As String
bad = "||127||129||141||143||144||160||173||" 'Characters that don't output something
'the human eye can see based on http://www.gtwiki.org/mwiki/?title=VB_Chr_Values
out = v
'Chop off the first character so long as it's white space
If v <> "" Then
Do While AscW(Left(out, 1)) < 33 Or InStr(1, bad, "||" & AscW(Left(out, 1)) & "||") <> 0 'Left(out, 1) = " " Or Left(out, 1) = Chr(9) Or Left(out, 1) = Chr(160)
out = Right(out, Len(out) - 1)
Loop
'Chop off the last character so long as it's white space
Do While AscW(Right(out, 1)) < 33 Or InStr(1, bad, "||" & AscW(Right(out, 1)) & "||") <> 0 'Right(out, 1) = " " Or Right(out, 1) = Chr(9) Or Right(out, 1) = Chr(160)
out = Left(out, Len(out) - 1)
Loop
End If 'else out = "" and there's no processing to be done
'Capture result for return
TrueTrim = out
End Function
TRIM() will remove all leading spaces
Sub demo()
Dim s As String
s = " test "
s2 = Trim(s)
msg = ""
For i = 1 To Len(s2)
msg = msg & i & vbTab & Mid(s2, i, 1) & vbCrLf
Next i
MsgBox msg
End Sub
It is possible your data has characters that are not visible, but are not spaces either.
Without seeing your code it is hard to know, but you could also use the Application.WorksheetFunction.Clean() method in conjunction with the Trim() method which removes non-printable characters.
MSDN Reference page for WorksheetFunction.Clean()
Why don't you try using the Instr function instead? Something like this
Function Comp2Strings(str1 As String, str2 As String) As Boolean
If InStr(str1, str2) <> 0 Or InStr(str2, str1) <> 0 Then
Comp2Strings = True
Else
Comp2Strings = False
End If
End Function
Basically you are checking if string1 contains string2 or string2 contains string1. This will always work, and you dont have to trim the data.
VBA's Trim function is limited to dealing with spaces. It will remove spaces at the start and end of your string.
In order to deal with things like newlines and tabs, I've always imported the Microsoft VBScript RegEx library and used it to replace whitespace characters.
In your VBA window, go to Tools, References, the find Microsoft VBScript Regular Expressions 5.5. Check it and hit OK.
Then you can create a fairly simple function to trim all white space, not just spaces.
Private Function TrimEx(stringToClean As String)
Dim re As New RegExp
' Matches any whitespace at start of string
re.Pattern = "^\s*"
stringToClean = re.Replace(stringToClean, "")
' Matches any whitespace at end of string
re.Pattern = "\s*$"
stringToClean = re.Replace(stringToClean, "")
TrimEx = stringToClean
End Function
Non-printables divide different lines of a Web page. I replaced them with X, Y and Z respectively.
Debug.Print Trim(Mid("X test ", 2)) ' first place counts as 2 in VBA
Debug.Print Trim(Mid("XY test ", 3)) ' second place counts as 3 in VBA
Debug.Print Trim(Mid("X Y Z test ", 2)) ' more rounds needed :)
Programmers prefer large text as may neatly be chopped with built in tools (inSTR, Mid, Left, and others). Use of text from several children (i.e taking .textContent versus .innerText) may result several non-printables to cope with, yet DOM and REGEX are not for beginners. Addressing sub-elements for inner text precisely (child elements one-by-one !) may help evading non-printable characters.
I have this formula in a table which basically collects data from two columns and combines them. Now, I'm looking to combine this formula with a REPLACE formula that basically takes these characters æ,ø,å and replaces them with a,o,a.
Here's the formula:
=LOWER(LEFT(tableFaste[[#This Row];[Fornavn:]])&tableFaste[[#This Row];[Etternavn:]])
Sorry, don't know of a Formula way to remove any of a list of characters from a string. You might have to revert to vba for this. Here's a user defined function to do it. Your formula will become
=DeleteChars([#UserName],{"æ","ø","å";"a","o","a"})
To replace the characters use {"æ","ø","å";"a","o","a"} where the list up to the ; is the old characters, after the ; the new. You can make the list as long as you need, just make sure the lists are the same length.
To Delete the characters replace use {"æ","ø","å"} an array list of characters you want to remove
UDF code:
Function DeleteChars(r1 As Range, ParamArray c() As Variant) As Variant
Dim i As Long
Dim s As String
s = r1
If UBound(c(0), 1) = 1 Then
For i = LBound(c(0), 2) To UBound(c(0), 2)
s = Replace(s, c(0)(1, i), "")
Next
Else
For i = LBound(c(0), 2) To UBound(c(0), 2)
s = Replace(s, c(0)(1, i), c(0)(2, i))
Next
End If
DeleteChars = s
End Function
You can use SUBSTITUTE
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(LOWER(LEFT(tableFaste[[#This Row];[Fornavn:]])&tableFaste[[#This Row];[Etternavn:]]),"æ","a"),"ø","o"),"å","a")