Count Occurrence of a word in a sentence in VBA - count

I want to count the occurrence of a particular word from a given string/sentence. I have already tried with below code but it's not working.
Sub main()
MainStr = " yes no yes yes no yes no "
Str1 = " yes "
MsgBox UBound(Split(MainStr, Str1))
End Sub
In the above code, I want to search Str1 from the MainStr. In most of the blogs, People gave solution to use "Split" function to count the occurrence. But it won't give correct results when the search word comes immediately after each other.
In above scenario, the search word is " yes " & it's coming at the 3rd & 4th position.
The above code will give correct result for below scenario when,
MainStr = " yes no yes no yes no yes "
Str1 = " yes "
Please help me with this As I have already tried/searched a lot to find the solution.
Thanks !

You can try:
HowManyOccurrences = ubound(split(whole_string, search_string))
which splits the whole_string using the search_string as the delimiter into and array that returns the number of elements in the array.
You will have to loop through then most likely (or come up with a recursive regex and then count captures or something):
Dim whole_string As String
Dim search_string As String
Dim temp As String
Dim ctr As Integer
whole_string = "yes no yes yes no yes no "
search_string = "yes"
temp = whole_string
ctr = 0
While (InStr(1, temp, search_string) > 0)
temp = Replace(temp, search_string, "", 1, 1)
ctr = ctr + 1
Wend
MsgBox (ctr)

I beleive you will need a loop, Not sure you can accomplish this with just 1 line of code, maybe I am wrong
Dim s As String
Dim searchWord As String
Dim iSearchIndex As Integer
Dim iCounter
searchWord = "YES"
s = "yes no yes yes no no yes yes yes no yes"
Do While True
'get the location of the search word
iSearchIndex = InStr(1, UCase(s), "YES")
'check to make sure it was found
If iSearchIndex > 0 Then
'create a string removing the found word
s = Mid(s, iSearchIndex + Len(searchWord))
'add 1 to our counter for a found word
iCounter = iCounter + 1
Else
Exit Do 'nothing found so exit
End If
Loop
MsgBox CStr(iCounter)

Related

Splitting a dataframe into parts by detection, then writing to multiple csv's?

I have a csv as shown in the image below. The data is a set of separate tables, separated by a blank line, that I require to be in separate csv files.
After importing to R, I'd like to split the data into the various separate tables, and then write these tables to separate csv files. I had the idea of using some kind of string detect, as a 'new' table is signified by the first instance of 'Area' in the first column. Any ideas of how to approach the code for this in R? There are a bunch of tables and doing this manually isn't advisable.
There's a truncation problem too it seems, as the tables will be required to have a differing amounts of columns, however I don't expect that getting rid of NULL or NA data should be too difficult with this.
Thanks for any help.
I don't think R is the right tool for this kind of thing. You should always try to use the right tool based on the task. Since you have Excel installed run this VBA script. That will do what you want.
Sub page_endings()
Dim i As Long 'how many times for pagebreak
Dim searchvalue_for_break_after 'value to do pagebreak
searchvalue_for_break_after = ""
'column A must be filled in with value break after
'example row 6, 12, 18, 24 whatever row you want
'will loop until empty row in column A
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row + 1
If Range("A" & i).Value = searchvalue_for_break_after Then
'will add a pagebreak after the row with value break after
ActiveWindow.SelectedSheets.HPageBreaks.Add before:=Range("A" & i).Offset(1)
End If
Next i
Call Create_Separate_Sheet_For_Each_HPageBreak
End Sub
Sub Create_Separate_Sheet_For_Each_HPageBreak()
Dim HPB As HPageBreak
Dim RW As Long
Dim PageNum As Long
Dim Asheet As Worksheet
Dim Nsheet As Worksheet
Dim Acell As Range
'Sheet with the data, you can also use Sheets("Sheet1")
Set Asheet = ActiveSheet
If Asheet.HPageBreaks.Count = 0 Then
MsgBox "There are no HPageBreaks"
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'When the macro is ready we return to this cell on the ActiveSheet
Set Acell = Range("A1")
'Because of this bug we select a cell below your data
'http://support.microsoft.com/default.aspx?scid=kb;en-us;210663
Application.Goto Asheet.Range("A" & Rows.Count), True
RW = 1
PageNum = 1
For Each HPB In Asheet.HPageBreaks
'Add a sheet for the page
With Asheet.Parent
Set Nsheet = Worksheets.Add(after:=.Sheets(.Sheets.Count))
End With
'Give the sheet a name
On Error Resume Next
Nsheet.Name = "Page " & PageNum
If Err.Number > 0 Then
MsgBox "Change the name of : " & Nsheet.Name & " manually"
Err.Clear
End If
On Error GoTo 0
'Copy the cells from the page into the new sheet
With Asheet
.Range(.Cells(RW, "A"), .Cells(HPB.Location.Row - 1, "K")).Copy _
Nsheet.Cells(1)
End With
' If you want to make values of your formulas use this line also
' Nsheet.UsedRange.Value = Nsheet.UsedRange.Value
RW = HPB.Location.Row
PageNum = PageNum + 1
Next HPB
Asheet.DisplayPageBreaks = False
Application.Goto Acell, True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Call SaveWorksheetsAsCsv
End Sub
Sub SaveWorksheetsAsCsv()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "C:\Users\Excel\Desktop\"
For Each WS In ThisWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
' about overwriting the original file.
End Sub
You should take each different table to the uppermost part. All in all, you have 5 tables with different dimensions (Table1: 11x13; Table2: 11x9; Table3: 3x12; Table4: 10x5; Table5: 6x7). Take them side-by-side in the above (A1:M11; N1:V11 etc.). The headings of tables would be in 1st row.
library(readxl)
# Use the path returned from getwd() function that is R's working directory
df <- as.data.frame(read_excel("C://Users//User//Documents//Revolution//Your.xlsx"))
Then, you can handle these 5 tables as:
Table1 <- df[,1:13]
Table2 <- df[,14:22]
Table3 <- df[1:3,23:34]
Table4 <- df[1:10,35:39]
Table5 <- df[1:6,40:46]
By caring dimensions stemmed from different row numbers in the assignmets, you do not face any NA or NULL value in Table1...Table5.

Checking content of textbox vb.net

I am using a text box for input to my SQL query. Based on the input I create a certain query and display the data in a gridview.
However I wish to make an adjustment for my users.
They often make an input like PL26... However this is not a valid name in the database to search for. Therefore I want to CHECK their input, and alter it accordingly, so they don't have to think about it.
I happen to know that when they type PL26 the correct input would be PL000026 ... The entity to search for is always "PL" + 6 characters/numbers... so if they wrote PL155, the number/string I pass to the sql query should become PL + 000 + 155 = PL000155.
I hope someone can help me how to accomplish this. That is if it is possible?
My idea/Pseudo code would be something like
If tbInput.txt's FIRST 2 CHARS are PL, then check total length of string
if StringLength < 8 characters, then
if length = 2 then ADD 4 0' after PL...
if length = 3 then add 3 0's after PL...
if length = 3 then add 3 0's after PL..
etc
....
...
Here we go:
Private Sub Button21_Click(sender As System.Object, e As System.EventArgs) Handles Button21.Click
Debug.Print(formatCode("PL1"))
Debug.Print(formatCode("PL"))
Debug.Print(formatCode("PL01"))
Debug.Print(formatCode("PL155"))
End Sub
Private Function formatCode(userInput As String) As String
Dim returnVal As String
If userInput.Length < 8 Then
returnVal = String.Concat(userInput.Substring(0, 2), userInput.Substring(2, userInput.Length - 2).PadLeft(6, "0"))
Else
returnVal = userInput
End If
Return returnVal
End Function
You may need to add some validation ensuring it starts with PL etc.
The following will work as long as there are no other non-numeric characters in between the PL and the numbers. You can always add it in your validation.
Dim newInput As String
If (input.StartsWith("PL")) Then
input = input.Remove(0, 2)
End If
' If this fails then it means the input was not valid
Dim numberPart = Convert.ToInt32(input)
newInput = "PL" + numberPart.ToString("D6")
Exctract a number by removing prefix "PL"
Parse to Integer
Use Custom Numeric Format Strings(zero placeholder) for adding zeros and prefix
Const PREFIX As String = "PL"
Dim exctractedNumber As Int32
If Int32.TryParse(tbInput.txt.Replace(PREFIX, String.Empty), exctractedNumber) = False Then
'Error nahdling
Exit Sub
End If
Dim finalFormat As String = String.Format("'{0}'000000", PREFIX)
Dim finalValue As String = exctractedNumber.ToString(finalFormat)
I would make use of the handy PadLeft method:
Dim input As String = "PL26"
Dim number As String = input.Substring(2, input.Length - 2)
If number.Length <> 6 Then
number = number.PadLeft(6, "0"C)
End If
MSDN String.PadLeft

Find first comma in string, then extract value between spaces

I'm extracting rows from a txt file.
This row contains values like this:
DESCRIPTION 1 1.234,00 15.980,00 [etc.]
I would like to extract these values (I mean only numeric values).
So I thought to find first comma, execute a for cycle backwards until first White space and execute a For cycle forward for decimals digits.
The I should go to the second comma and perform these cycles again.
Can you suggest some code that could be useful for my solution?
From your description, if you just need the decimal number before the comma, then you can do this with a pretty simple regex:
Dim s = "DESCRIPTION 1 1.234,00 15.980,00"
Dim pattern = "\d+(\.\d+)?,\d+"
Dim matches = System.Text.RegularExpressions.Regex.Matches(s, pattern)
For Each match in matches
Console.WriteLine(match.Value)
Next
'Outputs:
'
'1.234,00
'15.980,00
Here's a quick breakdown of the regex:
\d+ - \d is shorthand for [0-9], which just means "any numeric character". The + just indicates "one or more"
\. - this just matches a period character.
, - this just matches a comma.
( ... ) - parentheses just creates a group (think of it as a sub-regex)
? - question marks mean that the previous item is optional. In this case, that means that the group matching (\.\d+)? is optional, which allows you to match both 0.000,00 and 0,00
In that regex, if the comma and period are optional, then you can add a ? after them.
My Visual Basic knowledge is pretty limited, but can't you utilize the IsNumeric function available in VB.NET?
Someting like this:
' initial string/row/etc
Dim s As String = "DESCRIPTION 1 1.234,00 15.980,00"
' Split string based on spaces
Dim words As String() = s.Split(New Char() {" "c})
' Use For Each loop over split and display them
Dim word As String
For Each word In words
If IsNumeric(word) Then
Console.WriteLine(word & " is numeric")
Else
Console.WriteLine(word & " is not numeric")
End If
Next
I think you'll be needing to look at System.Text.Regex.
Match m = Regex.Match("DESCRIPTION 1 1.234,00 15.980,00", ".*?( [0-9]*?.(?'n1'[0-9]+),(?'n2'[0-9]+)))
While m.Success
System.Diagnostics.Debug.WriteLine(m.Groups["n1"].Value + " "+m.Groups["n2"].Value);
m = m.NextMatch()
End While
If the columns are fixed width, you can get the values like this:
Dim input As String = "DESCRIPTION 1 1.234,00 15.980,00"
Dim col1 As String = input.SubString(17, 12).Trim()
Dim col2 As String = input.SubString(29).Trim()

Further problems with counting occurrences of strings in an Array

I am copying a question and answer from elsewhere as it partly goes into what I need but not completely.
In ASP classic, is there a way to count the number of times a string appears in an array of strings and output them based on string and occurrence count?
For example if I have an array which contains the following :
hello
happy
hello
hello
testing
hello
test
happy
The output would be:
hello 4
happy 2
test 1
testing 1
The answer that was given was this:
I'm assuming the language is VBScript (since that's what most people use with classic ASP).
You can use a Dictionary object to keep track of the individual counts:
Function CountValues(pArray)
Dim i, item
Dim dictCounts
Set dictCounts = Server.CreateObject("Scripting.Dictionary")
For i = LBound(pArray) To UBound(pArray)
item = pArray(i)
If Not dictCounts.Exists(item) Then
dictCounts.Add item, 0
End If
dictCounts.Item(item) = dictCounts.Item(item) + 1
Next
Set CountValues = dictCounts
End Function
This is great but I can't work out how to grab the top 2 most used words, display them and be able to put them in their own variable for use elsewhere.
Can anyone help with this?
You can loop through the dictionary object using this method. Inside that loop keep track of the top two keys and their counts in either a new array or two new variables.
You can't sort a Dictionary object in VBScript, so you have to use something else.
My advice is using a disconnected Recordset object to hold the items and their occurrences. Such object natively support sorting and it's pretty easy to use. To achieve this have such function instead:
Function CountValues_Recordset(pArray)
Dim i, item
Dim oRS
Const adVarChar = 200
Const adInteger = 3
Set oRS = CreateObject("ADODB.Recordset")
oRS.Fields.Append "Item", adVarChar, 255
oRS.Fields.Append "Occurrences", adInteger, 255
oRS.Open
For i = LBound(pArray) To UBound(pArray)
item = pArray(i)
oRS.Filter = "Item='" & Replace(item, "'", "''") & "'"
If (oRS.EOF) Then
oRS.AddNew
oRS.Fields("Item").Value = item
oRS.Fields("Occurrences").Value = 1
Else
oRS.Fields("Occurrences").Value = oRS.Fields("Occurrences").Value + 1
End If
oRS.Update
oRS.Filter = ""
Next
oRS.Sort = "Occurrences DESC"
oRS.MoveFirst
Set CountValues_Recordset = oRS
End Function
And using it to achieve the output you want:
Dim myArray, oRS
myArray = Array("happy", "hello", "hello", "testing", "hello", "test", "hello", "happy")
Set oRS = CountValues_Recordset(myArray)
Do Until oRS.EOF
Response.Write(oRS("item") & " " & oRS("Occurrences") & "<br />")
oRS.MoveNext
Loop
oRS.Close
Set oRS = Nothing
Don't forget to close and dispose the recordset after using it.

Index of the current DataRow in a DataTable

For Each dr As myDAL.UsersRow In data
str.AppendLine(dr.UserName)
Next
In the above code, I also need to include the row index so that it's something like
str.AppendLine(dr.IndexNumber & " " & dr.UserName)
How can I achieve this?
P.S. data is not a DataTable but a generic list of myDAL.UsersRow
If data is a List<myDAL.UsersRow> as you suggest, you can use a "for" loop rather than a "for each" loop:
for i = 0 to data.Count - 1
str.AppendLine(i & " " & data[i].UserName)
next
If, however, you're implying that your "data" list is not in the same order as the original DataTable's rows, you might be able to use the DataRowCollection.IndexOf method to locate the row in the original table:
for each dr as myDAL.UsersRow in data
str.AppendLine(dr.Table.Rows.IndexOf(dr) & " " & dr.UserName)
next
Declare a counter variable before the ForEach loop, and increment it inside it.
Dim counter As Integer = 0
For Each dr As myDAL.UsersRow In data
counter = counter + 1
str.AppendLine(counter.ToString() & " " & dr.UserName)
Next

Resources