I have a long document that needs to replace the last number if it appears at the end of the line.
But sometimes this number is mixed with a letter:a or b.
So how to get the number and at "<a>" tag it?
Text Line 1
Text Line
Text Line 20a
Text Line 300b
Text COVID-19 4000
To
Text Line 1
Text Line
Text Line 20a
Text Line 300b
Text COVID-19 4000
This custom Function will work.
Function findTheEndNumner(theText As String) As String
Dim NewResult As String, finalResult As String, i As Long
NewResult = Mid(theText, InStrRev(theText, " ", -1, vbTextCompare) + 1, 999)
For i = 1 To Len(NewResult)
If IsNumeric(Mid(NewResult, i, 1)) Then
finalResult = finalResult & Mid(NewResult, i, 1)
End If
Next i
findTheEndNumner = finalResult
End Function
You can test it with this macro:
Sub test()
MsgBox findTheEndNumner("Text Line 1")
MsgBox findTheEndNumner("Text Line")
MsgBox findTheEndNumner("Text Line 20a")
MsgBox findTheEndNumner("Text Line 300b")
MsgBox findTheEndNumner("Text COVID-19 4000")
End Sub
Sample file also available if you want... download it here.
Related
This is the output of a program.
I have specified what shall be width of each cell in the program and my program shows correct output.
What I want to do is cell content shall be written from right to left. E.g highlighted figure 9983.54 has width of 21. Text file has used first 7 columns. But I want it to use last 7 columns of text file.
Please see expected output image.
I am not getting any clue how to do this. I am not a very professional programmer but I love coding. This text file is used as input to some other program and i am trying to automate writing text file from excel VBA.
Can anyone suggest a way to get this output format?
Here is the code which gave me first output
Option Explicit
Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As Integer)
Dim i As Long, j As Long
Dim strLine As String, strCell As String
'get a freefile
Dim fNum As Long
fNum = FreeFile
'open the textfile
Open strFile For Output As fNum
'loop from first to last row
'use 2 rather than 1 to ignore header row
For i = 1 To ws.Range("a65536").End(xlUp).Row
'new line
strLine = ""
'loop through each field
For j = 0 To UBound(s)
'make sure we only take chars up to length of field (may want to output some sort of error if it is longer than field)
strCell = Left$(ws.Cells(i, j + 1).Value, s(j))
'add on string of spaces with length equal to the difference in length between field length and value length
strLine = strLine & strCell & String$(s(j) - Len(strCell), Chr$(32))
Next j
'write the line to the file
Print #fNum, strLine
Next i
'close the file
Close #fNum
End Sub
'for example the code could be called using:
Sub CreateFile()
Dim sPath As String
sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
If LCase$(sPath) = "false" Then Exit Sub
'specify the widths of our fields
'the number of columns is the number specified in the line below +1
Dim s(6) As Integer
'starting at 0 specify the width of each column
s(0) = 21
s(1) = 9
s(2) = 15
s(3) = 11
s(4) = 12
s(5) = 10
s(6) = 186
'for example to use 3 columns with field of length 5, 10 and 15 you would use:
'dim s(2) as Integer
's(0)=5
's(1)=10
's(2)=15
'write to file the data from the activesheet
CreateFixedWidthFile sPath, ActiveSheet, s
End Sub
Something like this should work:
x = 9983.54
a = Space(21-Len(CStr(x))) & CStr(x)
Then a will be 14 spaces followed by x:
a = " 9983.54"
Here 21 is the desired column width --- change as necessary. CStr may be unnecessary for non-numeric x.
If you're going to right-justify a lot of different data to different width fields you could write a general purpose function:
Function LeftJust(val As String, width As Integer) As String
LeftJust = Space(width - Len(val)) & val
End Function
The you call it with LeftJust(CStr(9983.54), 21).
Also note that VBA's Print # statement has a Spc(n) parameter that you can use to produce fixed-width output, e.g., Print #fNum, Spc(n); a; before this statement you calculate n: n = 21-Len(CStr(a)).
Hope that helps
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
I have a number of items in cells that are separated by dashes. I'm trying to normalize the database by splitting rows so that each row contains only one entry. How do you find/count strings in Excel VBA. I know you can do values for whole cells with
myVar = Application.WorksheetFunction.COUNTIF(Range("A1:Z100"),"Value")
I need to search a single cell and find out how many hyphens there are. Example
123-456-789 = 2
9876-12 = 1
Using hint from ron's function above I've created this formula and it worked fine :
=LEN(A1) - LEN(SUBSTITUTE(A1, "-", ""))
This will count the number of hyphens in the activecell
Sub test()
a = Len(ActiveCell)
my_txt = Replace(ActiveCell, "-", "", 1, -1, vbTextCompare)
b = Len(my_txt)
numb_occur = a - b
End Sub
Here's the UDF to count single string occurence in string:
Option Explicit
Function COUNTTEXT(ref_value As Range, ref_string As String) As Long
Dim i As Integer, count As Integer
count = 0
If Len(ref_string) <> 1 Then COUNTTEXT = CVErr(xlErrValue): Exit Function
For i = 1 To Len(ref_value.value)
If Mid(ref_value, i, 1) = ref_string Then count = count + 1
Next
COUNTTEXT = count
End Function
Here's using Array formula:
=SUM(IF(ISERROR(SEARCH("-",MID(A1,ROW(INDIRECT("$1:$" & LEN(A1))),1))),0,1))
Entered using Ctrl+Shift+Enter.
Hope this helps.
I found this answer:
Sub xcountCHARtestb()
'If countCHAR(RANGE("aq528"), ".") > 0 Then 'YES
If countCHAR(Selection, ".") > 0 Then 'YES
MsgBox "YES" & Space(10), vbQuestion ', "title"
Else
MsgBox "NO" & Space(10), vbQuestion ', "title"
End If
End Sub
Sub xcountCHARtesta() 'YES
MsgBox "There are " & countCHAR(Selection, "test") & " repetitions of the character string", vbQuestion 'YES
End Sub
Function countCHAR(myString As String, myCHAR As String) As Integer 'as: If countCHAR(Selection, ".") > 1 Then selection OR RANGE("aq528") '"any char string"
countCHAR = UBound(split(myString, myCHAR)) 'YES
End Function
This code might be of your help .. you can also use it as a UDF... :)
Function CountHypens(rng_Src As Range) As Long
'A VARIANT FOR SPLITTING CELL CONTENTS
Dim var As Variant
On Error Resume Next
var = Split(rng_Src.Value, "-", , vbTextCompare)
If Err.Number <> 0 Then
Debug.Print "This cell does not have any hyphens."
Else
CountHypens = UBound(var)
End If
Err.Clear: On Error GoTo 0
End Function
Follow up to: davex, by davex.. :)
I had been looking all over trying to find a way to test same for find text string in a formula.
This answer seems to work correctly for both formulas / not & fits in a 1 liner..
(am still pretty novice at vba, let me know if any better way(s) ) thanks.
If countChar(UCase(Selection.Formula), UCase("offset")) > 0 Then 'YES (thee? answer, works for both formulas / not)
'If countChar(Selection.Formula, "OFFSET") > 0 Then 'yes
'If countChar(Cells(ActiveCell.row, Selection.Column).Formula, "OFFSET") > 0 Then 'yes
'If countChar(Cells(ActiveCell.row, "BG").Formula, "OFFSET") > 0 Then 'yes
'If countChar(UCase(Selection), UCase("OffSET")) > 0 Then 'yes but not work on formula
'If Selection.Formula Like "*offset*" Then 'no (for eq)
MsgBox "YES" & Space(15), vbQuestion
Else
MsgBox "NO" & Space(15), vbQuestion
End If
NOTE: in place of variable "BG" above, i use permanent work cells to improve use for column BG example, work cell A3 has / shows: BG:BG
=SUBSTITUTE(SUBSTITUTE(CELL("address",$BG3),"$",""),ROW(),"")&":"&SUBSTITUTE(SUBSTITUTE(CELL("address",$BG3),"$",""),ROW(),"")
you will also need to dim the work cell, at the top / before the vba:
Dim A3 As String
A3 = RANGE("A3")
pardon, tried 3 times to get all of code into 1 box. really suggest putting a code stop start icon in the toolbar.
I have a text file with questions, one per line. I want powerpoint to randomly select a line from the file and put that line into a label. I would also like to make sure that each line would only be used once. If there is no easy way of going about this, maybe a way to delete the line that was selected from the text file. I found some code online but it won't do what I want (not using the same line twice).
Try this
Sub do_file()
Dim myArray
Open [YOUR TEXT FILE HERE] For Input As #1
fileinfo = Input(LOF(1), #1)
Close #1
myArray = Split(fileinfo, vbCrLf)
myArray = ShuffleArray(myArray)
For i = 0 To UBound(myArray)
[YOUR LABEL HERE] = myArray(i)
Next i
End Sub
Function ShuffleArray(OrigArray As Variant) As Variant
Dim RandNum As Long
Dim Holder As Variant
Dim ReturnArray() As Variant
ReDim ReturnArray(LBound(OrigArray) To UBound(OrigArray))
For i = LBound(OrigArray) To UBound(OrigArray)
ReturnArray(i) = OrigArray(i)
Next i
For i = LBound(OrigArray) To UBound(OrigArray)
RandNum = Int((UBound(OrigArray) - LBound(OrigArray)) * Rnd + LBound(OrigArray))
If i <> RandNum Then
Holder = ReturnArray(i)
ReturnArray(i) = ReturnArray(RandNum)
ReturnArray(RandNum) = Holder
End If
Next i
ShuffleArray = ReturnArray
End Function
This will read the file put each line into an array and then will Shuffle the array. It will then loop through the shuffled array which is where you will need to include your labels for output of the questions.
I have a textbox that reads like so:
Line 1
Line 2
Line 3
**Line 4**
Line 1
Line 2
Line 3
**Line 4**
(repeats...)
How can I use VB to loop through the textbox, deleting Lines 1, 2, and 3, skipping the fourth, and repeat? Or, rather, record every fourth line into a new textarea?
I'd probably get the contents, split on the newline character to create an array of strings (one string per line), then loop through the array outputting only the ones i wanted.
If this is VB6 then bear in mind that the variable length String type is a reference type meaning that operations will involve taking a deep copy i.e. concatenation is expensive.
Dim lines() As String
lines = VBA.Split(TextBox1.Text, vbCrLf)
Dim counter As Long
For counter = 3 To UBound(lines) Step 4
lines(counter) = Chr$(22)
Next
TextBox1.Text = _
Replace$( _
Replace$( _
VBA.Join(lines, vbCrLf), _
vbCrLf & Chr$(22), vbNullString), _
Chr$(22) & vbCrLf, vbNullString, 1)
This is code for the previous answer.
Private Function EveryFourthLine(ByVal input As String) As String
Dim newtxt As String = ""
Dim oldtxt As String() = input.Split(vbCrLf)
For i As Integer = 1 To oldtxt.Count
If i Mod 4 = 0 Then
newtxt = newtxt & oldtxt(i - 1)
If i <> oldtxt.Count Then
'add a vbcrlf to all but the last line
newtxt = newtxt & vbCrLf
End If
End If
Next
Return newtxt
End Function
If this is VB.Net and you are using a Textbox - you don't need to split anything yourself. You can just access the .Lines property. You'll get back an array of strings
You certainly can loop through the rows, like others have shown; but another approach is to use LINQ to do that work for you.
txtBox1.Lines = (From curLine In txtBox1.Lines _
Where Array.IndexOf(txtBox1.Lines, curLine) Mod 4 = 3).ToArray
What you are saying here is that you want the Lines in the textbox to be equal to all of the lines that are already in the text box - as long as the index of that particular line, divided by 4 has a remainder of three.
That sounds complicated when you type it out like that, but really, all it's going to do is give you every fourth line, and set that back into the textbox.