In Excel 2010, using VBA, how can I breakapart a string when it finds a certain character?
Let say A1 = "This is a | test of | the | emergency broadcast signal"
And I assign that to a variable like
strColumnA = Range("A" & CStr(currRow)).Value
Now I want to append 4 new rows at the end of worksheet 2. All Column A, like:
A1 = "This is a"
A2 = "test of"
A3 = "the"
A4 = "emergency broadcast signal"
Any ideas?
Use this as there is no need for a loop, also it is important to leave the Application.Trim() in:
Sub test()
Dim r As Variant, s As String
s = [a1].Value
r = Split(Application.Trim(s), "|")
[b1].Resize(UBound(r, 1) + 1) = Application.Transpose(r)
End Sub
Use Split()
Sub Sample()
Dim Ret
Dim strColumnA As String
Dim i As Long
strColumnA = "This is a | test of | the | emergency broadcast signal"
Ret = Split(strColumnA, "|")
For i = LBound(Ret) To UBound(Ret)
Debug.Print Ret(i)
Next i
End Sub
Related
I have data that it's not in a consistent position in the cell, sometimes it has a semicolon, sometimes it is to the right or the left of the semicolon. The end result I'm looking is to have in column B all "students" (defined by not being teacher) and in Column C, all Teachers. If no student or teacher is found, then the corresponding cell should be blank.
Currently I'm doing a text to columns to separate both columns then using the following formulas to have the student and teacher separate:
=IF(SUMPRODUCT(--ISNUMBER(SEARCH({"Arts and Music","Math and Science"},A2)))>0,B2,C2)
=IF(SUMPRODUCT(--ISNUMBER(SEARCH("Teacher",A2)))>0,B2,C2)
I still have to do a manual Find and replace to remove the parenthesis and text and leave only the student/teacher name.
IS there any VBA macro that can help me to get from Column A to my expected result in columns B and C? Thank you.
You can use regular expressions to do this. See this post on how to enable them in excel.
Sub FindStrAndCopy()
Dim regEx As New RegExp
regEx.Pattern = "\s*(\w+)\s*\((.+)\)"
With Sheets(1):
Dim arr() As String
Dim val As String
Dim i As Integer, j As Integer
Dim person As String, teachOrSubject As String
Dim mat As Object
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row:
val = Cells(i, "A").Value
arr = Split(val, ";")
For j = 0 To UBound(arr):
Set mat = regEx.Execute(arr(j))
If mat.Count = 1 Then
person = mat(0).SubMatches(0)
teachOrSubject = mat(0).SubMatches(1)
If teachOrSubject = "Teacher" Then
Cells(i, "C").Value = person
Else
Cells(i, "B").Value = person
End If
End If
Next
Next
End With
End Sub
The macro splits the string on a semicolon and stores either 1 or 2 substrings in the 'arr' array. It then does a regular expression on each one. If the string inside the parenthesis is "Teacher" then the preceding person's name is stored in column "C" otherwise it's a student and the name is stored in column "B".
I create a button that read all the registers you have on column A
then put the students on column B
then put the Teacher on column C
Check that I used "(Teacher)" to know when a teacher is in the String
I used the sheet Called "Sheet1"
And I don't use the first row because is the header row.
If you have any question please contact me.
Private Sub CommandButton1_Click()
'---------------------------------Variables-----------------------------
Dim total, i, j As Integer
'--------------Counting the number of the register in column A----------
ThisWorkbook.Sheets("Sheet1").Range("XDM1").Formula = "=COUNTA(A:A)"
total = CInt(ThisWorkbook.Sheets("Sheet1").Range("XDM1").Value)
'---------------------Creating arrays to read the rows------------------
Dim rows(0 To 1000) As String
Dim columnsA() As String
'------------Searching into the rows to find teacher or student---------
For i = 2 To total
columnsA = Split(ThisWorkbook.Sheets("Sheet1").Range("A" & i).Value, ";")
first = LBound(columnsA)
last = UBound(columnsA)
lenghtOfArray = last - first
MsgBox lenghOfArray
For j = 0 To lenghtOfArray
If InStr(columnsA(j), "(Teacher)") > 0 Then
MsgBox columnsA(j)
ThisWorkbook.Sheets("Sheet1").Range("C" & i).Value = columnsA(j)
Else
ThisWorkbook.Sheets("Sheet1").Range("B" & i).Value = columnsA(j)
End If
Next j
Next i
'--------------------------------Finishing------------------------------
End Sub
I'm doing numerical integration in Excel VBA and I want to get the equation from the user instead of inserting it in the Cell.
Example
The user gives me x^3+x^2+2 which is F(X)
In A1, I have number 2 and I evaluate F(X) in B1.
How to tell excel that the equation input from user is =A1^3+A2^2+2. I just need that conversion to one cell.
I'm using Val(InputBox())
Thanks for the help
If the user enters x or X and you only need to replace X with A1.cell.value then use this:
Sub test()
formula_user = InputBox("Please type formula")
Range("B1").Formula = "=" & Replace(LCase(formula_user), "x", "A1")
End Sub
x is replace with A1 in the formula from the user inputbox. It can be upper or lower case in the user input
The Application Evaluate function can resolve the formula received from the user but you will have to find someway to convert x to a cell reference that can be correctly understood. This may require the worksheet name.
Your x^3+x^2+2 example replaces two x values with A1 and A2. It may be better as x^3+y^2+2 so that there is no ambiguity between what is A1 and what is A2.
Sub f_of_x_and_y()
Dim fmla As String, str As String
fmla = InputBox("enter formula")
With Worksheets("Sheet2")
str = Replace(Replace(fmla, "x", .Range("A1").Address(external:=True)), _
"y", .Range("A2").Address(external:=True))
.Range("A3") = Application.Evaluate(str)
End With
End Sub
Sub variable_input()
Dim userFormula$
Dim myVar&
myVar = 2
userFormula = InputBox("What is the formula?")
Debug.Print userFormula
userFormula = Replace(userFormula, "x", myVar)
Debug.Print userFormula
Dim theAnswer$
theAnswer = Val(userFormula)
Debug.Print theAnswer
End Sub
You can replace all "x" with the string "A1". Don't forget to add "=" in front...
Sub TestUserEquation()
Dim strUserEquation As String
strUserEquation = LCase(InputBox("Please enter your equation:", "Equation InputBox"))
If strUserEquation <> "" Then
Cells(1, 2) = "=" & Replace(strUserEquation, "x", "A1")
Else
Cells(1, 2) = "No equation entered."
End If
End Sub
I have a class ("Names"):
Option Explicit
Public companyName As String
Public companyCode As String
Public companyCountry As String
Property Get fullInfo() As String
fullInfo = "Code " & companyCode & " is " & companyCountry & " for " & companyName
End Property
and in a Sub() in a Module, I have the following:
Sub classTest()
Dim c1 As New Names
Dim c2 As New Names
c1.companyCode = 14
c1.companyCountry = "Ivory Coast"
c1.companyName = "Ivory Company"
c2.companyCode = 11
c2.companyCountry = "Cameroon"
c2.companyName = "Cameroon Company"
Dim i As Integer
debug.print c1.fullInfo
End Sub
This correctly will print "Code 14 is Ivory Coast for Ivory Company".
How can I write a loop to go through ALL the properties (is that the right word? is c1, c2, a 'property'?). I tried something like below, but it didn't work:
for i = 1 to 2
debug.print ci.fullInfo
next i
You can see that it obviously won't work - but how can I get it to do so? Sorry, I don't know what the c1 part is called, nor what's the part after the . is called)
If you store c1,c2,etc in an array or collection then you can loop over them using a standard For loop and call fullInfo for each of them.
Sub Tester()
Dim col As New Collection, n As Names, i
For i = 1 To 10
Set n = New Names
n.companyCode = i
n.companyCountry = "Country_" & i
n.companyName = "Company_" & i
col.Add n
Next i
For Each n In col
Debug.Print n.fullInfo
Next n
End Sub
Look at a for each loop. Something like
For Each variable_name In collection_name
'Some code here.
Next variable_name
At the very outset, let me confess. I am not a developer nor do I have any technical background. However, I have learned a bit of coding. I want to a regular expression for finding every nth position of a character. For example, google, yahoo, rediff, facebook, cnn, pinterest, gmail. I want to find every third occurrence of the comma in the string and replace it with a semicolon. This is for a excel vba macro I am working on. For now, I am trying to loop through it and then replace. If the data is large, the macro fails. Would appreciate your reply. Thanks a ton in advance.
Here is what I am doing:
Option Explicit
Sub reg()
Dim regx As RegExp
Set regx = New RegExp
Dim allMatches As Object
Dim contents As String
Dim contents2 As String
contents = "hello, wow, true, false, why, try, cry, haha"
contents = "contents1" & contents
regx.pattern = ",{4}"
regx.Global = True
regx.IgnoreCase = False
Set allMatches = regx.Execute(contents)
contents2 = regx.Replace(contents, ";")
MsgBox contents2
End Sub
I get the data from all selected cells. Join it. Add semicolon (an indicator for the row end) at every fourth comma found. Please suggest if there is a better way to do it as I am new to this:
Here is what I have done currently by looping through array. I want to avoid this.
Function insertColon(sInputString As String) As Variant
Dim data3 As String
Dim sFind As String
Dim sReplacewith As String
Dim result As String
'Dim i As Integer
Dim Counter As Integer
sFind = ","
sReplacewith = ";"
data3 = sInputString
' MsgBox = data3
' Dim J As Integer
Application.Volatile
FindN = 0
'Dim i As Integer
' i = 1
Counter = 4
' MsgBox Len(data3)
While InStr(Counter, sInputString, sFind)
FindN = InStr(Counter, sInputString, sFind)
data3 = Application.Substitute(data3, sFind, sReplacewith, Counter)
Counter = Counter + 3
' MsgBox "loop" & i
'
' i = i + 1
Wend
If I understood you properly then all your code could be summarized to a few lines
Dim sText As String
sText = "hello, wow, true, false, why, try, cry, haha, huh, muh"
For p = 3 To Len(sText) Step 2
sText = WorksheetFunction.Substitute(sText, ",", ";", p)
Next p
MsgBox sText
'Output
'hello, wow, true; false, why, try; cry, haha, huh; muh
Test it and let me know whether it fails. If not don't forget to accept the answer.
I am trying to make a program that changes letters in a string and i keep running into the obvious issue of if it changes a value, say it changes A to M, when it gets to M it will then change that M to something else, so when i run the code to change it all back it converts it as if the letter was originally an M not an A.
Any ideas how to make it so the code doesnt change letters its already changed?
as for code ive just got about 40 lines of this (im sure theres a cleaner way to do it but im new to vba and when i tried select case it would only change one letter and not go through all of them)
Text1.value = Replace(Text1.value, "M", "E")
Try this:
Dim strToChange As String
strToChange = "This is my string that will be changed"
Dim arrReplacements As Variant
arrReplacements = Array(Array("a", "m"), _
Array("m", "z"), _
Array("s", "r"), _
Array("r", "q"), _
Array("t", "a"))
Dim strOutput As String
strOutput = ""
Dim i As Integer
Dim strCurrentLetter As String
For i = 1 To Len(strToChange)
strCurrentLetter = Mid(strToChange, i, 1)
Dim arrReplacement As Variant
For Each arrReplacement In arrReplacements
If (strCurrentLetter = arrReplacement(0)) Then
strCurrentLetter = Replace(strCurrentLetter, arrReplacement(0), arrReplacement(1))
Exit For
End If
Next
strOutput = strOutput & strCurrentLetter
Next
Here is the output:
Thir ir zy raqing ahma will be chmnged
Loop through it using the MID function. Something like:
MyVal = text1.value
For X = 1 to Len(MyVal)
MyVal = Replace(Mid(MyVal, X, 1), "M", "E")
X = X + 1
Next X
EDIT: OK upon further light, I'm gonna make one change. Store the pairs in a table. Then you can use DLookup to do the translation, using the same concept:
MyVal = text1.value
For X = 1 to Len(MyVal)
NewVal = DLookup("tblConvert", "fldNewVal", "fldOldVal = '" & Mid(MyVal, X, 1) & "")
MyVal = Replace(Mid(MyVal, X, 1), Mid(MyVal, X, 1), NewVal)
X = X + 1
Next X
Here's another way that uses less loops
Public Function Obfuscate(sInput As String) As String
Dim vaBefore As Variant
Dim vaAfter As Variant
Dim i As Long
Dim sReturn As String
sReturn = sInput
vaBefore = Split("a,m,s,r,t", ",")
vaAfter = Split("m,z,r,q,a", ",")
For i = LBound(vaBefore) To UBound(vaBefore)
sReturn = Replace$(sReturn, vaBefore(i), "&" & Asc(vaAfter(i)))
Next i
For i = LBound(vaAfter) To UBound(vaAfter)
sReturn = Replace$(sReturn, "&" & Asc(vaAfter(i)), vaAfter(i))
Next i
Obfuscate = sReturn
End Function
It turns every letter into an ampersand + the replacement letters ascii code. Then it turns every ascii code in the replacement letter.
It took about 5 milliseconds vs 20 milliseconds for the nested loops.