Parsing a String in Excel VBA without Leaving Trailing Spaces? - excel
I am currently working on an Excel spreadsheet capable of exporting data from the Yahoo Finance API for dynamic stock quote analysis. I am having problems properly parsing the values into my excel spreadsheet. The issue is that the last column of numeric values have a trailing space character, which prevents Excel from recognizing it as a number and formatting it in comma style.
Here is the function I use currently:
Function UpdateStockData(rawWebpageData As String)
Dim stockQuotes As Variant
Dim stockQuoteValues As Variant
Dim i As Integer
Dim j As Integer
stockQuotes = Split(rawWebpageData, vbLf)
For i = 0 To UBound(stockQuotes)
If InStr(stockQuotes(i), ",") > 0 Then
stockQuoteValues = Split(stockQuotes(i), ",")
For j = 0 To UBound(stockQuoteValues)
sheet.Cells(5 + i, 4 + j).Value = stockQuoteValues(j)
sheet.Cells(5 + i, 4 + j).Value = Trim(sheet.Cells(5 + i, 4 + j).Value)
Next j
End If
Next i
End Function
Here is some sample data:
43.99,44.375,41.97,42.62,30098498
573.37,577.11,568.01,573.64,1871694
16.03,16.14,15.93,16.17,25659400
128.54,129.56,128.32,129.36,31666340
126.32,126.68,125.68,126.27,1629499
105.57,106.00,104.78,106.35,4972937
82.58,83.21,82.20,83.37,6214421
27.89,27.9173,27.62,27.83,1003967
49.07,49.56,48.92,49.55,13870589
43.055,43.21,42.88,43.28,25748692
34.12,34.41,33.72,34.095,23005798
159.42,160.56,158.72,161.03,3633635
43.01,43.90,41.00,40.30,10075067
100.25,100.48,99.18,99.74,9179359
139.54,140.49,138.75,140.69,1311226
119.86,120.05,118.7828,120.20,2931459
42.50,42.98,42.47,42.95,16262994
78.02,78.99,77.66,78.99,1826464
89.87,91.35,89.86,91.02,1773576
15.84,15.98,15.76,15.99,78441600
69.50,70.2302,69.49,70.49,2343967
80.895,81.15,78.85,79.60,28126686
33.08,33.20,32.955,33.25,739726
83.08,83.80,82.34,83.16,4475302
64.72,64.90,64.27,64.27,5147320
35.64,41.85,35.40,40.78,15871339
83.08,83.80,82.34,83.16,4475302
22.93,23.099,22.71,23.10,5290225
18.47,19.00,18.30,18.98,71891
69.65,69.684,69.08,69.98,5992137
154.35,155.22,154.00,155.57,4476188
80.08,81.16,79.77,81.51,7731275
47.79,48.87,47.31,48.58,2219634
23.04,23.21,22.97,23.23,891504
114.76,115.47,114.25,116.07,3799034
80.63,81.56,80.56,81.91,6140957
25.66,25.77,25.47,25.86,31543764
87.18,87.96,86.93,87.62,13467554
58.31,58.795,57.61,58.255,5791024
174.62,175.78,174.41,176.15,1035588
84.35,85.24,84.21,85.16,7369986
42.03,42.25,41.69,41.98,3192667
34.19,34.49,34.01,34.57,15652895
101.65,102.12,101.17,102.34,8665474
7.88,8.01,7.84,7.88,10425638
62.13,62.17,61.3525,61.97,16626413
23.10,23.215,22.85,23.18,651929
The last value of each row of data above is where the problem occurs.
Check the value of the last char on the last iteration it might be a return char. You can use the left function to take what you want or replace.
It would be easier to answer if we I can see the value of rawWebpageData variable.
Check the cell format, you can try to set it to numeric if it is text.
If I was doing it I would debug the data and step through it to look for characters that i'm not checking.
Related
Seperating a character string
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
VB.NET Get Number Position Of Char In String (Index Of)
im having a hard time getting a function working. I need to search message.text for each "," found, for each "," found I need to get the number position of where the "," is located in the string. For example: 23232,111,02020332,12 it would return 6/10/19 where the "," are located (index of). My code finds the first index of the first , but then just repeats 6 6 6 6 over, any help would be appreciated thanks.
Heres my code:
For Each i As Char In message.Text
If message.Text.Contains(",") Then
Dim data As String = message.Text
Dim index As Integer = System.Text.RegularExpressions.Regex.Match(data, ",").Index
commas.AppendText(index & " ")
End If
Next
You can try it this way; instantiate a Regex object and increment each time the position from which you start the matching (this possibility is not available with the static method Match).
Dim reg As New System.Text.RegularExpressions.Regex(",")
Dim Index As Integer = reg.Match(data).Index
Do While Index > 0
commas.AppendText(index & " ")
Index = reg.Match(data, Index + 1).Index
Loop
p.s the returned indices are zero-based.
Just use the Regex.Matches method Dim message As String = "23232,111,02020332,12" Dim result As String = "" For Each m As Match In Regex.Matches(message, ",") result &= m.Index + 1 & " " Next I should also add that indexes are 0 based (which is why +1 is added to m.Index). If you later need these values to point to the position of a particular comma, you may be off by 1 and could potentially try to access an index larger than the actual string.
Subscripts (font) in excel vba
I'm trying to populate an array which is composed of greek letters followed by a subscript "1". I already have the greek letters part: Dim variables(), variables_o j = 0 For i = 1 To 25 If i = 13 Or i = 15 Then Else j = j + 1 ReDim Preserve variables(j) variables(j) = ChrW(944 + i) End If Next But I'm having trouble with the subscript part. I figure that if I could use the with ... end with feature then I could do it but I'm having trouble figuring out what objects the with ... end with can take. On this website they say: With...End With Statement (Visual Basic) The data type of objectExpression can be any class or structure type or even a Visual Basic elementary type such as Integer. But I don't know what that means. If could do something like this: dim one as string one = "1" with one font.subscript = true end with Then I could figure out how to do what I want. But the with feature does not seem to act on strings. The problem I'm having is that most of the advice for fonts somewhere along the line use the cell method but I want to populate an array, so I'm having trouble. Again what I would ideally like to do is create some dimension which is simply a subscripted one and then alter my array as follows: Dim variables(), variables_o j = 0 For i = 1 To 25 If i = 13 Or i = 15 Then Else j = j + 1 ReDim Preserve variables(j) variables(j) = ChrW(944 + i) & subscript_one End If Next
To my knowledge, there are no out-of-the-box methods or properties to store the font.Subscript property of a character or series of characters within a string that also contains the characters.
You could use inline tags, like in HTML, to indicate where the subscript begins and ends. For example:
variables(j) = ChrW(944 + i) & "<sub>1</sub>"
Then, when you write out variable, you would parse the string, remove the tags and set the font.Subscript property accordingly.
However, if you're always appending a '1' to each Greek letter, I would just append it to the string, then set the font.Subscript property on the last character of the string when outputting it. For example:
variables(j) = ChrW(944 + i) & "1"
...
For j = 0 to Ubound(variables)
With Worksheets("Sheet1").Cells(j + 1, 1)
.Value = variables(j)
.Characters(Len(variables(j)), 1).Font.Subscript = True
End With
Next j
If you're writing to something other than a cell in a worksheet, it has to support Rich-Text in order for the subscript to show, e.g. a Rich-Text enabled TextBox on a user form. You should be able to use the .Characters object on those controls in a similar manner.
See MSDN-Characters Object for more information.
Qualifier errors when attempting to debug, along with final lines -- help pls
Below is the code i have put together from various examples to try achieve my goal. Concept is to be dynamic and retrieve from survey sheet within my workbook, to be able to obtain the corresponding TVD for the MD
--Use while loop only to run code if there is a depth in Column B Present. Nested loop uses the difference between depths to calculate a gradient.
---The issue i'm having is getting past my first debug error "Invalid Qualifier".
----Lastly, any suggestions for how i would then return the TVD to Column A, relevant to the looked up MD, within the nested loop to maintain the row in which the MD was grabbed. Sorry for making this so wordy, been working on this for over 10hrs while at work.
http://www.wellog.com/tvd.htm
Sub MdtoTVD()
Dim MD1 As String, MD2 As Integer
Dim TVD1 As String, TVD2 As Integer
Dim Srng As Range 'Survey MD column
Dim MDrng As Range 'MdtoTVD MD column as range
Dim MDdiff As Integer ' Var to calculate difference of MD end from MD start
Dim TVDdiff As Integer ' Var to calculate difference of TVD end from TVD start
Dim TVDincr As Double ' var to use for stepping TVD
Dim MDrow As Integer
Dim i As Long
MDrng = Range("Surveys!B27:B215") 'range from the survey sheet within my report book
Srng = Range("Surveys!G27:G215") 'range from the survey sheet within my report book
Dim X As Integer
X = 2
While Not (IsEmpty(Sheets("MDtoTVD").Cells(X, 2).Value)) 'runs loop as long as there a MD depth to be looked up
Cells(X, 2) = MDrow 'assigns current row value to for MD input
MD1.Value = Application.WorksheetFunction.Index(Srng, Application.WorksheetFunction.Match(MDrow, MDrng, 1)) ' retrieves Start point for MD
MD2.Value = Application.WorksheetFunction.Index(Srng, Application.WorksheetFunction.Match(MDrow, MDrng, 1) + 1) 'retrieves end point for MD
TVD1.Value = Application.WorksheetFunction.Index(MDrng, Application.WorksheetFunction.Match(MDrow, Srng, 1)) 'retrieves start point for TVD
TVD2.Value = Application.WorksheetFunction.Index(MDrng, Application.WorksheetFunction.Match(MDrow, Srng, 1) + 1) 'retrieves end point for TVD
MDdiff.Value = (MD2 - MD1) 'assigns and calculates difference of MD end from MD start
TVDdiff.Value = (TVD2 - TD1) 'assigns and calculates difference of TVD end from TVD start
TVDincr.Value = MDdiff / TVDdiff 'Divides MD by TVD to get increment per foot
For i = 1 To MDdiff Step TVDincr 'set max loop run to amount of feet between survey points
Cells(X, 1).Value = TVD1 + i 'uses the loop to increment the TVD from start point
Next i
Wend
End Sub
I can see a number of problems with your code:
MD1, MD2, TVD1, TVD2 are all of type String. Also, MDdiff, TVDdiff and TVDIncr are all of type Integer. The property Value is not defined for a string or integer variable. Just remove the .Value from all of them and you won't get the "Invalid Qualifier" error.
After you do the above, the following lines will give another error about type mismatch:
MDdiff = (MD2 - MD1)
TVDdiff = (TVD2 - TD1)
because you're trying to subtract a string from another string and assign the result to an integer. Not sure what to advise there, you have to consider what you're trying to achieve and act accordingly. Maybe they shouldn't be strings in the first place? I don't know, up to you to determine that.
At the very least, you can cast strings to integers if you're really sure they're string representations of integers by doing CInt(string_var) or use CLng to convert to long. If the strings are not string representations of integers and you try to cast them to integers, you'll get a type mismatch error.
When you assign a value to a Range object, you need to use Set. So do:
Set MDrng = Range("Surveys!B27:B215")
Set Srng = Range("Surveys!G27:G215")
to correctly set the ranges.
Another problem is that you haven't assign a value to X but you use it as a cell index. By default, uninitialised numeric variables in VBA get assigned the value of 0, so doing .Cells(X, 2) will fail because row 0 is not a valid row index.
In this line:
TVDincr = MDdiff / TVDdiff
you're dividing two integers and you assign the result to another integer. Note that if the result of the division happens to be a decimal (like 3 / 2 = 1.5), your TVDincr integer will actually contain just 1, i.e. you lose some precision. I don't understand your code to know if it's ok or not, you have to judge for yourself, I'm pointing it out just in case you're not aware of that.
Also, if TVDdiff happens to be 0, then you'll get a "division by zero" error.
This line in your For loop:
Cells(X, 1).Value = TVD1 + i
will also generate an error, because you're trying to numerically add TVD1 (a string) and i (a long). Perhaps you're trying to concatenate the two, in which case you should replace + with &.
There's also a problem when calling the WorksheetFunctions, but I haven't been able to determine the cause. Probably if you fix the other errors then it'll be easier to understand what's going on, not sure though. You just have to investigate things a little bit too.
Phone number format
I have a table field 'Phone number', the data in table is imported through a excel file link in database. The data type of the field is text since we are not sure how user enters his phone number(sometime with country code and sometime without country code). I want to format the 'phone number' field once the table is updated everytime or data is imported into table. Format [countrycode]-[localcode]-[phone num]. I am not sure how to go about it, whether to create an update query or VBA code to update this field. Will appriciate any help in this regards.
It is generally recommended that in database fields, the phone number is maintained in numerical format only (meaning no parenthesis, dashes, or whatnot) because it provides more stability for the data and allows for better/easier future formatting when outputting. The most recommended method is to take the number given to you and strip it of all non-numeric characters and then store that value. If you are working with an excel sheet containing this information before it is put into the database, then you can simply format the column that contains the phone numbers to convert everything into a single numerical value so 800-555-1212 or (888) 222-1515 would just become 8005551212 and 8882221515. This can be done using the existing cell formatting option built into Excel or if you want it done on the fly a simple VBA code that triggers when the field has a value would do the trick too. EDIT #1 (super simple function) Public Function numOnly(sToClean As String) As String Const NUM_CHARS = "0123456789" Dim lChar As Long Dim sResult As String For lChar = 1 To Len(sToClean) If InStr(1, NUM_CHARS, Mid$(sToClean, lChar, 1)) > 0 Then 'Found a numeric character sResult = sResult + Mid$(sToClean, lChar, 1) End If Next 'Return the result numOnly = sResult End Function EDIT #2 (more feature advanced version) Option Explicit Public Function stripChars(CheckStr As String, Optional KillNums As Boolean = False, Optional AllowedChars As String, Optional NotAllowed As String) ' CheckStr = the string being evaluated ' KillNums [True/False] = remove numbers/remove non-numeric ' AllowedChars = what to allow even if you are removing non-numeric (aka KillNums=False) [ex. "$,."] or removing numbers (aka KillNums=True) [ex. "6,9"] ' NotAllowed = override characters never allowed and processed before any other option (meaning if you have it in both allow/not allow - not allow takes precedence ' NOTE: AllowedChars and NotAllowed arguments are *not* case-sensitive Dim Counter As Long Dim TestChar As String Dim TestAsc As Long ' Loop through characters For Counter = 1 To Len(CheckStr) ' Get current character and its ANSI number TestChar = Mid(CheckStr, Counter, 1) TestAsc = Asc(TestChar) ' Test first to see if current character is never allowed If InStr(1, NotAllowed, TestChar, vbTextCompare) > 0 Then ' do nothing ' If current character is in AllowedChars, keep it ElseIf InStr(1, AllowedChars, TestChar, vbTextCompare) > 0 Then stripChars = stripChars & TestChar ' If KillNums=True, test for not being in numeric range for ANSI ElseIf KillNums Then 'only allow non-numbers If TestAsc < 48 Or TestAsc > 57 Then stripChars = stripChars & TestChar End If ' If KillNums=False, test for being in numeric ANSI range Else 'only allow numbers If TestAsc >= 48 And TestAsc <= 57 Then stripChars = stripChars & TestChar End If End If Next End Function You can drop either of these in your Excel's module (Alt+F11) or in your Access forms or what not, good luck.