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

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

Related

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

VBA Greater Than Function Not Working

I have an issue where I am trying to compare a values that can be alphanumeric, only numeric, or only alphabetic.
The code originally worked fine for comparing anything within the same 100s group (IE 1-99 with alphabetic components). However when I included 100+ into it, it malfunctioned.
The current part of the code reads:
For j = 1 To thislength
If lennew < j Then
enteredval = Left("100A", lennew)
ElseIf lennew >= j Then
enteredval = Left("100A", j)
End If
If lenold < j Then
cellval = Left("67", lenold)
ElseIf lenold >= j Then
cellval = Left("67", j)
End If
'issue occurs here
If enteredval >= cellval Then
newrow = newrow+1
End If
Next j
The issue occurs in the last if statement.
When cycling through the 100 is greater than the 67 but still skips over. I tried to declare them both as strings (above this part of code) to see if that would help but it didn't.
What I am trying to accomplish is to sort through a bunch of rows and find where it should go. IE the 100A should go between 100 and 100B.
Sorry lennew=len("100A") and lennold=len("67"). And thislength=4or whatever is larger of the two lengths.
The problem is that you're trying to solve the comparison problem by attacking specific values, and that's going to be a problem to maintain. I'd make the problem more generic by creating a function that supplies takes two values returns -1 if the first operand is "before" the second, 0 if they are the same, and 1 if the first operand is "after" the second per your rules.
You could then restructure your code to eliminate the specific hardcoded prefix testing and then just call the comparison function directly, eg (and this is COMPLETELY untested, off-the-cuff, and my VBA is VERRRRRY stale :) but the idea is there: (it also assumes the existence of a simple string function called StripPrefix that just takes a string and strips off any leading digits, which I suspect you can spin up fairly readily yourself)
Function CompareCell(Cell1 as String, Cell2 as String) as Integer
Dim result as integer
Dim suffix1 as string
Dim suffix2 as string
if val(cell1)< val(cell2) Then
result = -1
else if val(cell1)>val(cell2) then
result = 1
else if val(cell1)=val(cell2) then
if len(cell1)=len(cell2) then
result =0
else
' write code to strip leading numeric prefixes
' You must supply StripPrefix, but it's pretty simple
' I just omitted it here for clarity
suffix1=StripPrefix(cell1) ' eg returns "ABC" for "1000ABC"
suffix2=StripPrefix(cell2)
if suffix1 < suffix2 then
result = -1
else if suffix1 > suffix2 then
result = 1
else
result = 0
end if
end if
return result
end function
A function like this then allows you to take any two cell references and compare them directly to make whatever decision you need:
if CompareCell(enteredval,newval)>=0 then
newrow=newrow+1
end if

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.

Comparing Strings in VBA

I have a basic programming background and have been self sufficient for many years but this problem I can't seem to solve. I have a program in VBA and I need to compare two strings. I have tried using the following methods to compare my strings below but to no avail:
//Assume Cells(1, 1).Value = "Cat"
Dim A As String, B As String
A="Cat"
B=Cell(1, 1).Value
If A=B Then...
If A Like B Then...
If StrCmp(A=B, 1)=0 Then...
I've even tried inputting the Strings straight into the code to see if it would work:
If "Cat" = "Cat" Then...
If "Cat" Like "Cat" Then...
If StrCmp("Cat" = "Cat", 1) Then...
VBA for some reason does not recognize these strings as equals. When going through Debugger it shows that StrComp returns 1. Do my strings have different Char lengths? Thanks for any help.
Posting as answer because it doesn't fit in the comments:
I find it hard to believe that something like:
MsgBox "Cat" = "Cat"
Would not display True on your machine. Please verify.
However, I do observe that you are most certainly using StrComp function incorrectly.
The proper use is StrComp(string, anotherstring, [comparison type optional])
When you do StrComp(A=B, 1) you are essentially asking it to compare whether a boolean (A=B will either evaluate to True or False) is equivalent to the integer 1. It is not, nor will it ever be.
When I run the following code, all four message boxes confirm that each statement evaluates to True.
Sub CompareStrings()
Dim A As String, B As String
A = "Cat"
B = Cells(1, 1).Value
MsgBox A = B
MsgBox A Like B
MsgBox StrComp(A, B) = 0
MsgBox "Cat" = "Cat"
End Sub
Update from comments
I don't see anything odd happening if I use an array, just FYI. Example data used in the array:
Modified routine to use an array:
Sub CompareStrings()
Dim A As String, B() As Variant
A = "Cat"
B = Application.Transpose(Range("A1:A8").Value)
For i = 1 To 8
MsgBox A = B(i)
MsgBox A Like B(i)
MsgBox StrComp(A, B(i)) = 0
MsgBox "Cat" = B(i)
Next
End Sub
What I would check is how you're instantiating the array. Range arrays (as per my example) are base 1. If it assigned some other way, it is most likely base 0, so check to make sure that you're comparing the correct array index.

Resources