Excel VBA- remove part of the string - vba

I am trying to delete part of the string. For example
mystring="site, site text, sales "
I want to remove 'site' from mystring. My required output is "site text, sales"
I use this line of code :
s1 = Replace(mystring, "site", "")
but i am getting "text, sales"
I am not sure how to do this and I'd really appreciate your help!

replace("site, site text, sales ","site, ","",1,1)
You can also send as a parameter the start position and then the number of times you want to replace... (the default is -1)

There are a lot of different options here :
Just by adding the coma in the search string to be replaced and use Trim to get rid of spaces :
s1 = Trim(Replace(mystring, "site,", ""))
Specify the number of time you want the string to be replaced (first "1" is the start, the second for the number of replacements)
s1 = Trim(Replace(mystring, "site,", "",1,1))
Or the hard/bad way, to decompose your string in two pieces after the first occurence and then recombine to get result...
TempStart = Left(mystring, InStr(1, mystring, "site") + Len(mystring) + 1)
TempEnd = Replace(mystring, TempStart, "")
TempStart = Replace(TempStart, "site", "")
mystring = CStr(TempStart & TempEnd)

You can also user VB's MID function like this:
Mystring=Mid(myString, 6)
output will be "site text, sales"
Just specify the number of characters you want to be removed in the number part.

In my case I wanted to remove the part of the strings that was between "[" and "]". And the following code worked great.
So With original string in column A (and solution in column B):
Sub remove_in_string()
Dim i, lrowA, remChar As Long
Dim mString As String
lrowA = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lrowA
mString = Cells(i, 1).Value
If InStr(mString, "[") > 0 Then
remChar = InStr(mString, "]") - InStr(mString, "[") + 1
Cells(i, 2).Value = Left(mString, Len(mString) - remChar)
ElseIf InStr(mString, "[") = 0 Then
Cells(i, 2).Value = Cells(i, 1).Value
End If
Next
End Sub

Related

Access VBA How to extract a text outside a [] from a String

In an Access Form I can enter values in a TextBox called LenD. Sometimes I need to check the input code in order to split standard text from a code. For instance:
noumnoum[codecode]
To obtain:
noumnoum
So that, I use this:
If InStr(1, Me!LenD, "[") Then
Me!LenD = Left(Mid(Me!LenD, InStr(1, Me!LenD, "[") + 1, (InStr(1, Me!LenteD, "]")) - (InStr(1, Me!LenD, "[")) - 1), 50)
Else
Me!LenD = Left(Me!LenD, 50)
End If
But I just obtain the string inside the "[" "]". My aim would be to obtain the string that is on the left of the original String. Any idea on why it does not work?
You can use Split and simplify this:
If Not IsNull(Me!LenD) Then
Me!LenD = Left(Split(Me!LenD, "[")(0), 50)
End If
Dim x as Long
x = Instr(me!LenD,"[")
If x > 0 then
Me!LenD = Left(Me!lenD,x-1)
Else
me!LenD = Left(Me!LenD,50)
End If

VBA script to replace cell value and keep formatting

I have the below table in word that I'm trying to write a script to replace the contents of the below cell with a different customer payment (i.e replace the £1,100 with £2,000). Below is a snippet of my script but the when I write back to the cell it loses all the formatting and the numbered list.
How can I keep replace the cell data with very similar data and still keep the formatting?
ps. I've simplified the contents of the cell to make it easier to read, so the code won't apply to exactly that content
DescPlan = Trim(t1.Cell(2, 2).Range.Text)
DescTest = InStr(1, DescPlan, ":")
finalString = Left(DescPlan, DescTest)
t1.Cell(2, 2).Range.Text = Replace(DescPlan, finalString, "Payment by the customer of " + Format(v, "Currency") + " will be due upon completion of items below:")
Not sure if this helps but you are using a table so what works for excel should also work for you.
Sub replace_keep_format()
Dim t1 As Range
Dim sStrng As String, rStrng As String
Dim i As Integer
sStrng = "£1,100"
rStrng = "£2,000"
i = 1
Do Until ThisWorkbook.Sheets(1).Range("a" & i) = ""
Set t1 = ThisWorkbook.Sheets(1).Range("a" & i)
t1 = Replace(Expression:=t1, Find:=sStrng, Replace:=rStrng)
i = i + 1
Loop
End Sub

Excel if cell contain "-" near number then move

What I need to do is to basically write lessons number. There are 3 colomns.
The second column is running by a custom formula called LessonsLeft done by someone from my second thread on stackoverflow and it is
Function LessonsLeft(rng As Range) As String
If rng.Count > 1 Then Exit Function
Dim spltStr() As String
Dim i As Long
spltStr = Split(rng.Value, ",")
LessonsLeft = ",1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,"
For i = LBound(spltStr) To UBound(spltStr)
LessonsLeft = Replace(LessonsLeft, "," & spltStr(i) & ",", ",")
Next i
LessonsLeft = Mid(LessonsLeft, 2, Len(LessonsLeft) - 2)
End Function
What I need to do is to add another, third colomn which is for lessons that my students did their first attempt but they couldnt pass exam.
How i want the data to be there, is to write for exemple a "-" or "+" near a number in first column so the number will move to third column.
How can it be done ?
use this function
Function LessonsAttemptedButNotDone(rng As Range) As String
If rng.Count > 1 Then Exit Function
Dim spltStr() As String, lessonDone As String
Dim i As Long
spltStr = Split(rng.Value, ",")
For i = LBound(spltStr) To UBound(spltStr)
lessonDone = spltStr(i)
If Right(lessonDone, 1) = "-" Then
lessonDone = Left(lessonDone, Len(lessonDone) - 1)
LessonsAttemptedButNotDone = LessonsAttemptedButNotDone & lessonDone & ","
End If
Next
If LessonsAttemptedButNotDone <> "" Then LessonsAttemptedButNotDone = Left(LessonsAttemptedButNotDone, Len(LessonsAttemptedButNotDone) - 1)
End Function

vba pulling names from fields using instr and left/right

Me again everyone. I am trying to pull various strings and place a string in a separate field. I cannot seem to get my code to work and I am hoping someone can shine some light in my flawed attempts. Thank you very much.
I have column "B" which includes multiple names and is in the following format:
B C D
Other Team teamOne teamTwo
/jdoe/smithjr/
/someguy/testuser/
/obiwan/luke/darth
/vader/
/hp/dell/lenova/mint/
I only need to take the first two names and place one name in one field and one name in another field.
Expected results
B C D
Other Team teamOne teamTwo
/jdoe/smithjr/ jdoe smithjr
/someguy/testuser/ someguy testuser
/obiwan/luke/darth obiwan luke
/vader/ vader
/hp/dell/lenova/mint/ hp dell
The code I have come up with so far is below and does not work. I receive errors that there is no data to replace.
For Q = 2 To 10
If UCase(Cells(Q, "B").Value) Like "*Other Team*" Then
Name = Cells(Q, "B").Value
startingPosition = InStr(Name, "/")
Firstname = Left(Name, (startingPosition) - 1)
secondName = Right(Name, startingPosition - 2)
Cells(Q, "C").Value = Firstname
Cells(Q, "D").Value = secondName
End If
Next Q
I am pretty new to VBA (on 3rd day) and cannot seem to figure out how to parse this data. Perhaps someone can explain what I am doing wrong and assist me? Thank you.
Since you have a delimited string, I'd personally use the Split function. Note also that your If UCase(Cells(Q, "B").Value) Like "*Other Team*" Then test fails on every input in your sample data - it is only true for the column header that you skip, assuming that you change the test to uppercase like you do the input. If you're trying to determine if you're on the correct worksheet, it needs to go outside of the loop.
Something like this:
If UCase$(Cells(1, "B").Value) Like "*OTHER TEAM*" Then
Dim tokens() As String
For Q = 2 To 10
Name = Cells(Q, "B").Value
tokens = Split(Name, "/")
If UBound(tokens) > 0 Then Cells(Q, "C").Value = tokens(1)
If UBound(tokens) > 1 Then Cells(Q, "D").Value = tokens(2)
Next Q
End If
just to put in a "formula" approach
Sub main()
If UCase$(Cells(1, "B").Value) Like "*OTHER TEAM*" Then
Range("c2:c10").FormulaR1C1 = "=MID(RC2,2,SEARCH(""/"",RC2,2)-2)"
Range("d2:d10").FormulaR1C1 = "=IF(ISNUMBER(SEARCH(""/"",RC2,SEARCH(""/"",RC2,2)+1)),MID(RC2,SEARCH(""/"",RC2,2)+1,SEARCH(""/"",RC2,SEARCH(""/"",RC2,2)+1)-SEARCH(""/"",RC2,2)-1),"""")"
End If
a more "clear" format of which could be
Dim str1 As String, str2 As String, formula1 As String, formula2 As String
str1 = "SEARCH(""/"",RC2,2)"
str2 = "SEARCH(""/"",RC2," & str1 & "+1)"
formula1 = "=MID(RC2,2," & str1 & "-2)"
formula2 = "=IF(ISNUMBER(" & str2 & "),MID(RC2," & str1 & "+1," & str2 & "-" & str1 & "-1),"""")"
If UCase$(Cells(1, "B").Value) Like "*OTHER TEAM*" Then
Range("c2:c10").FormulaR1C1 = formula1
Range("d2:d10").FormulaR1C1 = formula2
End If

Application or Object defined error - VBA Excel 2013

I want code to check one column of data for a condition ie: Range Qualification. If they are required to go the the Range the value will be "REQ" if they are not the values will be "E", "S", "M", and "NR". I use [select case] to check the condition. At the start of the select case I get this error.
I am not sure if I am making the sell reference right or not. After the array is populated with names from another column, I then go through and remove the empty elements from the array and then display all elements of the array in a msgbox. Below is the code I used:
'Declares total number of personnel as integer
Dim total As Integer
total = Worksheets("MASTER").Range("C4").Value
'Declares single element array with personnel full names
ReDim names(total) As String
'Loops through the array checking to see if personnel have qualified on the Rifle Range
For i = (1 + 6) To (total + 6)
Select Case Worksheets("MASTER").Range(Cells(i, 23)).Text
Case "REQ"
names(i - 6) = Worksheets("MASTER").Range(Cells(i, 7)).Value
Case "NR"
names(i - 6) = vbNullString
Case "E"
names(i - 6) = vbNullString
Case "S"
names(i - 6) = vbNullString
Case "M"
names(i - 6) = vbNullString
End Select
Next
'Declares a new array to remove blank elements from the orignal array
ReDim msgnames(LBound(names) To UBound(names))
'Loops through new array removing empty elements
For i = LBound(names) To UBound(names)
If names(i) <> vbNullString Then
x = x + 1
msgnames(x) = names(i)
End If
Next
'Displays every element of the array
For i = LBound(msgnames) To UBound(msgnames)
msg = msg & msgnames(i) & vbNewLine
Next
'Declares COMP, NOTCOMP, REQ and NOTREQ variables
Dim COMP As String
Dim NOTCOMP As String
Dim REQ As String
Dim NOTREQ As String
'Adds a comment to the bottom of the Message Box
MsgBox msg, vbOKOnly, "Rifle Range"`
You have the wrong syntax for your range.
Change this:
Select Case Worksheets("MASTER").Range(Cells(i, 23)).Text
to this:
Select Case Worksheets("MASTER").Cells(i, 23).Value2
One other thing -- you should use .value or .value2 instead of .text unless you have a very specific reason for using .text. See Charles Williams' article for an excellent analysis of the three properties: TEXT vs VALUE vs VALUE2 - Slow TEXT and how to avoid it.