count of character from one position until it reaches a Space Using VBA - vba

I would like to take the count of character from one position until it reaches a Space Using VBA
Sub testing()
Dim YourText As String
YourText = "my name ismanu prasad"
Cells(1, 1).Value = Len(YourText)
End Sub
Above code will return 21 as output. But my scenario is bit different .I need the count of substring “manu” from the above string and output should be 4

Sub Display4thWord()
Dim Space As String
Dim YourText As String
Dim Begin4thWord As Integer
Dim End4thWord As Integer
YourText = "The first message box display a value"
Space = " "
'Find begin of 4th word.
Begin4thWord = InStr(InStr(InStr(1, YourText, Space, vbBinaryCompare) + 1, YourText, Space, vbBinaryCompare) + 1, YourText, Space, vbBinaryCompare)
'Find end of 4th word/begin of 5th word
End4thWord = InStr(Begin4thWord + 1, YourText, Space, vbBinaryCompare)
MsgBox (Begin4thWord)
'Display 4th word
MsgBox (Mid(YourText, Begin4thWord, End4thWord - Begin4thWord))
End Sub
You need to embed InStr function and use with Mid function.
Is it satisfaction you? This solution have hard code number number of word which it will return.

Declare two variables recordnocount & recordnocount
.position is the value we have
recordnocount = InStr(position + 20, text, " ")
recordnocount1 = recordnocount - (position + 20)
we can get the count .
Thankyou All

Related

for to next loop every word the first letter will be capital

what will i do to make it accept my equation and able to make all inserted word first letter capital? i f5 this equation and it show some yellow errors if i input a word.
i tried if i = 0 then
so it only shows first word first letter capital the rest isnt.
https://m.facebook.com/story.php?story_fbid=209840356412510&id=100021596419779&refid=17&tn=%2AW-R&_rdr
You didn't post your code on your post so i don't know what you tried but this code works perfectly in order to achieve your goal.
Dim textBoxString As String = TextBox1.Text.Trim
'Create a string array with every words'
Dim words() As String = textBoxString.Split(" ")
'labelString is our final result'
Dim labelString As String = ""
'cycle throught every word'
For i = 0 To textBoxString.Length - 1
Try
'substring(0,1) takes only the first char of the word'
words(i) = words(i).ToUpper().Substring(0, 1) & words(i).Substring(1, words(i).Length - 1)
labelString = labelString & words(i) & " "
Catch ex As Exception
Err.Clear()
Exit For
End Try
Next
Label1.Text = labelString
Little explanation of my code
words(i).ToUpper.Substring(0,1)
it takes only the first char of every word throught the cycle.
words(i).Substring(1, words(i).Lenght -1)
it takes the entire word without the first char
labelString = labelString & words(i) & " "
it concatenates every words back together.

Extracting Date/Time from comment cell

I have a comment field with cells containing text like this:
Cancelled by user at 2018-01-03 03:11:57 without charge
I want to get the date and time information, but it may not always be in the 3rd/4th from last spaces, otherwise I might try to do some sort of complicated split of the cell. Is there an "in cell" way extract the date time information? Or will this need a VBA script? I prefer the former, but I'm trying to make a macro to simplify my life anyway, so VBA would work too.
I'd propose the following formula:
=MID(A1,FIND("at 20",A1)+3,19)
This would require that the date is always preceded by the word 'at' and the date string starts with 20.
You can try this function. It splits the string checking for items that have the first letter numeric, and builds a result string of just the date information.
Public Function ParseForDate(sCell As String) As String
Dim vSplit As Variant
Dim nIndex As Integer
Dim sResult As String
vSplit = Split(sCell, " ")
For nIndex = 0 To UBound(vSplit)
If IsNumeric(Left$(vSplit(nIndex), 1)) Then
sResult = sResult & vSplit(nIndex) & " "
End If
Next
ParseForDate = Trim$(sResult)
End Function
If you wanted to use it in a formula it would look something like this:
=ParseForDate(A1)
To use it in a VBA routine:
Dim s as String
s = ParseForDate(Range("A1"))
Non-VBA solution: (this is assuming the date format is always the same for all cells)
= MAX(IFERROR(DATEVALUE(MID(A1,ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(A1)-19)),20)),0))
+MAX(IFERROR(TIMEVALUE(MID(A1,ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(A1)-19)),20)),0))
Note this is an array formula, so you must press Ctrl+Shift+Enter instead of just Enter when typing this formula.
You will obviously then need to format the cell as a date and time, but this formula gets the numerical value that Excel uses for its internal date and time system.
Using a regex will enable you to fetch the date and time, irrespective of its placement in the string. The following solution will work if the date and time are of the same format as shown in the example string.
Code:
Sub getDateTime()
Dim objReg, matches, str
str = Sheet1.Cells(1, 1).Value 'Change this as per your requirements
Set objReg = CreateObject("vbscript.regexp")
objReg.Global = True
objReg.Pattern = "\d{4}(?:-\d{2}){2}\s*\d{2}(?::\d{2}){2}"
If objReg.test(str) Then
Set matches = objReg.Execute(str)
strResult = matches.Item(0)
MsgBox strResult
End If
End Sub
Click for Regex Demo
Regex Explanation:
\d{4} - matches 4 digits representing the year
(?:-\d{2}){2} - matches - followed by 2 digits. {2} in the end repeats this match 2 times. Once for getting MM and the next time for DD
\s* - matches 0+ whitespaces to match the space between the Date and Time
\d{2} - matches 2 digits representing the HH
(?::\d{2}){2} - matches : followed by 2 digits. The {2} in the end repeats this match 2 times. First time for matching the :MM and the next time for matching the :SS
Screenshots:
Output:
This will be good for about 90 years (using cell C3 for example):
Sub GetDate()
Dim s As String
s = Range("C3").Comment.Text
arr = Split(s, " ")
For i = LBound(arr) To UBound(arr)
If Left(arr(i), 2) = "20" Then
msg = arr(i) & " " & arr(i + 1)
MsgBox msg
Exit Sub
End If
Next i
End Sub

Substring in a string

I am trying to pick a substring from a string.
Example: I want to pick the table no from the below string starting from "T".
Changes in table T682 (SAP TABLE)
The position of the start of the table no is same ie 17th position, but the characters in a table name are not constant. So I basically want a substring that picks from the 17th position till it finds a space. I am using the below code but it doesn't seem to work.
Position = InStr(1, A, " ")
TableNo = Mid(A, 17, Position)
Here is what you need to do:
Dim A As String
Dim StartPosition As Integer
Dim EndPosition As Integer
A = "Changes in table T682 (SAP TABLE)"
StartPosition = InStr(1, A, "T")
EndPosition = InStr(StartPosition, A, " ")
tableno = Mid(A, StartPosition, EndPosition - StartPosition)
There are two mistakes in your code:
1. The first parameter of instr should be 18. You want to find the first space after the starting point
2. The last parameter of mid is the number of characters
So your code should look something like this:
Position = InStr(18, a, " ")
TableNo = Mid(a, 18, Position - 18)
The space before T682 is character 17, the table start at character 18 so we just need to find the space after that.
The GetTable function can also be used as a worksheet function, e.g. in cell B1 enter =GetTable(A1) to return T682.
Sub Test()
Debug.Print GetTable("Changes in table T682 (SAP TABLE)")
End Sub
Public Function GetTable(Target As Range) As String
GetTable = Mid(Target, 18, InStr(18, Target, " ") - 18)
End Function
Another way
s = "Changes in table T682 (SAP TABLE)"
Debug.Print Trim(Split(Split(s, "(")(0), "T")(1))
I am assuming the following. The format of the string will be constant i.e
There will be no other Capital T before (
There will be only 1 (
The number T* will be before the (

How to convert bit number to digit

I'm working to create an Excel macro using VBA to convert bit strings to numbers. They are not binary numbers, each '1' stands for it's own number.
e.g: 1100000000000000000010001
from the left, the first bit represents "1", the second bit represents "2", third bit represents "0", and so on. The total quantity of bits in each string is 25.
I want VBA to convert it and show results like so: 1, 2, 21, 25.
I tried using Text to Columns but was not successful.
Try something like this:
Sub Execute()
Dim buff() As String
Dim i As Integer, total As Double
buff = Split(StrConv(<theString>, vbUnicode), Chr$(0))
total = 0
For i = 0 To UBound(buff)
Debug.Print (buff(i))
'total = total + buff(i) * ??
Next i
End Sub
Consider:
Public Function BitPicker(sIn As String) As String
For i = 1 To Len(sIn)
If Mid(sIn, i, 1) = 1 Then
BitPicker = BitPicker & i & ","
End If
Next
BitPicker = Mid(BitPicker, 1, Len(BitPicker) - 1)
End Function
Another non-VBA solution, based on the OP' initial approach and with a layout designed to facilitate multiple 'conversions' (ie copy formulae down to suit):
Does this have to be VBA? Give a data setup like this:
The formula in cell B4 and copied down to B33 is:
=IF(ROWS(B$3:B3)>LEN($B$1)-LEN(SUBSTITUTE($B$1,"1","")),"",FIND("#",SUBSTITUTE($B$1,"1","#",ROWS(B$3:B3))))
The formula cells are formatted as General and the the Bit String cell (B1) is formatted as Text.
Try this:
Function ConvertMyRange(Rng As Range) As String
Dim MyString As String
MyString = Rng.Text
Dim OutPutString As String
For i = 1 To Len(MyString)
If Mid(MyString, i, 1) = "1" Then OutPutString = OutPutString & ", " & i
Next i
' Get rid of first ", " that was added in the loop
If Len(OutPutString) > 0 Then
OutPutString = Mid(OutPutString, 2)
End If
ConvertMyRange = OutPutString
End Function
For your input, the output is 1, 2, 21, 25

Word VBA code to cut numbers from one column and paste them in another

I am looking for some code that can search cell by cell in the 2nd column of a table for numbers and decimal points, cut them and paste them in the cell to the left whilst leaving the text behind.
For example:
1(tab space)Test
1.1(tab space)Test
1.1.1(tab space)Test
1.1.1.1(tab space)Test
Where the bullet points represent separate cells in different columns.
In all instances the numbers are separated from the text by a tab space "Chr9" (as indicated in the example)
Any help or useful snippets of code would much appreciated!
EDIT: I have some code that scans each cell in a column but I dont know the code to tell it to only cut numbers and decimal points up to the first tab space.
The Split function delivers what you are after. Sample code:
Dim inputString As String
Dim splitArray() As String
Dim result As String
inputString = "1 Test"
splitArray = Split(inputString, " ")
If(UBound(splitArray) >= 1) Then 'Making sure that it found something before using it
result = splitArray(1) 'Text
End If
inputString = "1.1 Test"
splitArray = Split(inputString, " ")
If(UBound(splitArray) >= 1) Then
result = splitArray(1) 'Text
End If
'etc.
UPDATE
Code delivering the functionality you want:
Dim splitArray() As String
Dim curTable As Table
Set curTable = ActiveDocument.Tables(1)
For Row = 1 To curTable.Rows.Count
With curTable
splitArray = Split(.Cell(Row, 2).Range.Text, " ")
If (UBound(splitArray) >= 1) Then
.Cell(Row, 2).Range.Text = splitArray(1)
.Cell(Row, 1).Range.Text = splitArray(0)
End If
End With
Next Row