Subscripts (font) in excel vba - excel

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.

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

VBA - How to check if a string variable/cell contains another string Variable?

basically, I need to find a way to check if a String variable contains another String variable(or preferably an item from an array). Here's my case:
I have a list of 15k+ Strings in Excel, and another one with 5k+ Strings.The Second list is composed of 3 character long abbreviations, and the first one might contain from 0 to 15 of those, separated by ", ". My goal is to count each occurrence, of each of those abbreviations.
I've approached this by creating an array containing all the abbreviations. Then I was hoping to loop through the 15k+ long list 5k+ times, to count the occurrences of each of those abbreviations, changing the abbreviation sought every loop. However I'm stuck with comparing the strings...
I've tried to use InStr to see if I get 0 or not. Although it worked for me before when I referred to a String being searched by variable, but it seems that expression sought can't be placed in such a way. I've been trying to use Find or Application.Match instead but had the same issue... I wonder if there is a VBA function I don't know about? Or maybe someone has an idea for a custom function or an entirely different approach? I've hit a brick wall...
Thank you in advance for any advice! I highly appreciate it.
Unfortunately I can't show you the data since it's customer's sensitive data but here's my loop:
With ActiveWorkbook
For p = 1 To size
For j = 6 To lrow
a = .Sheets("Server View").Cells(j, 3).Value
tmp = Apps(p)
test = InStr(1, a, tmp)
If test = 0 Then
Else
b = .Sheets("Server View").Cells(j, 9).Value
If b = PROD Then
cval = .Sheets("temp").Cells(j, 3).Value
cval = cval + 1
.Sheets("temp").Cells(j, 3).Value = cval
Else
cval = .Sheets("temp").Cells(j, 2).Value
cval = cval + 1
.Sheets("temp").Cells(j, 2).Value = cval
End If
End If
Next j
Next p
End With

Selecting Characters In String

I can grab every 2 chars from sum2.text in order (102030) i get 10,20,30
but my issue is, selecting exactly those numbers 10,20,30 in order
my current code below outputs: msgbox(10) msgbox(20) msgbox(30) but wont select and replace those exact numbers in order one by one
My code:
For i = 0 To sum2.Text.Length - 1 Step 2 'grabs every 2 chars
Dim result = (sum2.Text.Substring(i, 2)) 'this holds the 2 chars
MsgBox(result) 'this shows the 2 chars
sum2.SelectionStart = i 'this starts the selection at i
sum2.SelectionLength = 2 'this sets the length of selection (i)
If sum2.SelectedText.Contains("10") Then
sum2.SelectedText = sum2.SelectedText.Replace("10", "a")
End If
If sum2.SelectedText.Contains("20") Then
sum2.SelectedText = sum2.SelectedText.Replace("20", "b")
End If
If sum2.SelectedText.Contains("30") Then
sum2.SelectedText = sum2.SelectedText.Replace("30", "c")
End If
my probolem is that it will show the numbers in sum2 one by one correctly, but it would select and replace at all or one by one. I believe the issue is with the selection length
OK, here's my attempt from what I'm understanding you are wanting to do. The problem is, you are trying to alter the string that the loop is using when you replace "10" with "a" so you need to create a variable to hold your newly built string.
Dim part As String = ""
Dim fixed As String = ""
For i = 0 To Sum2.SelectedText.Length - 1 Step 2
part = Sum2.SelectedText.Substring(i, 2)
Select Case part
Case "10"
part = part.Replace("10", "a")
Case "20"
part = part.Replace("20", "b")
Case "30"
part = part.Replace("30", "c")
End Select
fixed &= part
Next
Sum2.SelectedText = fixed
Of course, this is only to show the workings of moving through the string and changing it. You would need to replace your selected text with the newly formatted result (fixed in this case)
Result: ab3077328732
Also, just so you know, if this format was such that no 2 digits would interfere, you could simply do a
sub2.selectedtext.replace("10", "a").Replace("20", "b").Replace...
However if you had 2 digits like 11 next to 05 it would fail to give desired results because if would change 1105 to 1a5. Just something to think about.
Here's some code to get you started:
For i = 0 To sum2.SelectedText.Length - 1 Step 2
MessageBox.Show(sum2.SelectedText.Substring(i, 2))
Next

Can a logic test for an `if` statement be a variable in excel vba?

I have the following function:
Function get_equal_array_subset(column_label As String, _
loop_array() As Variant, _
values_array() As Variant)
' this function outputs an array of value from the values_array, based on a loop through the loop_array
' column_label is the first item in the array of the ouput array; i.e. the column lable of a new range
' loop_array is array being looped through and testing each value
' valus_array is the array from which values are taken with the test is met in the first array
' *** arrays have to be of equal lenght ***
Dim subset_array() As Variant
subset_array = Array(column_label)
Dim rows_dim As Long
Dim cols_dim As Integer
Dim agent_subset_counter As Long
agent_subset_counter = 0 ' counter to set the key for the new array
For rows_dim = 2 To UBound(loop_array, 1)
For cols_dim = 1 To UBound(loop_array, 2)
If loop_array(rows_dim, cols_dim) > 2 Then
agent_subset_counter = agent_subset_counter + 1 ' increase the subset counter by 1
ReDim Preserve subset_array(agent_subset_counter) ' resize the array account for the next id
subset_array(agent_subset_counter) = values_array(rows_dim, cols_dim) ' add the new id to the agent subset
End If
Next cols_dim
Next rows_dim
get_equal_array_subset = subset_array
End Function
Is there a way for me to make the If loop_array(rows_dim, cols_dim) > 2 Then a variable? Let's say I wanted the test to be > 3 or = 5 or non blank...etc.
I would go for the magic Application.Evaluate() method of the Application class. An example might be to define a series of tests into an array, let's say:
Dim myTests(4)
myTests(1) = "> 3"
myTests(2) = "= 5"
myTests(3) = "+3 < 5"
myTests(4) = "- 4 + sum(1,2) < 5"
Hence, using the simple statement:
If Application.Evaluate(loop_array(rows_dim, cols_dim) & myTests(j)) Then
Clearly, the variable j should be defined depending on the test you want to use and this kind of method would allow you to define several arrays of operators (one array for operators like +, - etc., another one for values like 3, 5 etc.)
NOTE If you don't know it yet, the Application.Evaluate() method will evaluate the expression and returning the result as Excel would do. It's basically using the same code that Excel uses to evaluate what you write in a cell:
Application.Evaluate("2+3") --> 5
Application.Evaluate("2 < 3") --> True
Application.Evaluate("IF(2=3,1,2)") --> 2
'etc.
If you wanted to make the "magic number" 2 into a variable, then you would use an array item in place of the 2.If, however, you wanted separate logic, then you use use a Select Case structure.

Parsing a String in Excel VBA without Leaving Trailing Spaces?

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.

Resources