I have a variable which contains five words.
Eg:- My name is Albert Einstein.
If the first word is "My" then it should be bold, else the word has to be deleted.
Hope the below code logic could help you to solve the problem:
Sub test1()
Debug.Print boldAndDeletion("Your name is Albert Einstein.")
End Sub
Function boldAndDeletion(inputString As String) As String
Dim splitStr1 As Variant
splitStr1 = Split(inputString, " ")
If splitStr1(0) = "My" Then
boldAndDeletion = "<b>My</b>" & Mid(inputString, 3)
Else
boldAndDeletion = Empty
End If
End Function
Related
I'm struggling with VBA code. I'm working on a ID code generator program. One of the processes involves Split Company Names by words, and taking the first two words. Split has proved to be useful in this tasks, however, when in dealing with Company Names shorter than 2 words I've got a #VALUE! Error.
One way I tried to fix it, was using the ISERROR function, so if I get any error it replaces it with a character, say "X".
In summary, what I'm trying is to capture only the second Word of the Name, if there is no second Word, just display "X".
Public Function idcode_2(text As String) As String
Dim Arr_text As Variant
Dim rz_x, rz2, code As String
Dim i As Integer
Dim c
Arr_text = Split(text, " ", 3)
rz2 = Arr_text(1)
If IsError(rz2) = True Then
rz2 = "X"
Else
rz2 = rz2 & ""
End If
idcode_2 = rz2
End Function
I'm using VBA in Excel - Microsoft Office Professional Plus 2013.
Arr_text will be a zero-based array - UBound(Arr_text) will give you the upper bound of that array (zero if one item, one if two items, etc)
Public Function idcode_2(text As String) As String
Dim Arr_text As Variant, rz2
Arr_text = Split(text, " ", 3)
If UBound(Arr_text ) > 0 Then
rz2 = Arr_text(1)
Else
rz2 = "x"
End If
idcode_2 = rz2
End Function
Public Function idcode_2(text As String) As String
If Instr(text, " ") > 0 Then
idcode = Split(text)(1)
Else
idcode = "x"
End If
End Function
What I'm trying to do
Locate the column whose header cell contains a unique string. In other words, I know the cell's text, and I know the cell is in row 1, but I don't know which column. NOTE: I want to search for the entire text, not just part of it. NOTE2: The text can vary, so I cannot hardcode the value into my code. Rather I need to use the variable in which the value is stored.
The problem
When there's no carriage return in the header text, a simple newCol = Range("1:1").Find(headerText).Column works fine. However, if there is a carriage return, this doesn't work. It throws up the error "Object variable or With block variable not set". Here's my exact header string:
Incomplete Email
(more text)
What I've already tried
I also tried using WorksheetFunction.Match(headerText, Range("1:1"), 0), but got the same issue.
Additional notes and requirements
This is part of an add-in, so I do not want to change anything in the user's excel sheet if I don't have to (i.e., I don't want to remove the carriage return).
Technically, I'm doing this in a function:
Public Function getColumn(headerText As Variant)
getColumn = Range("1:1").Find(headerText).Column
End Function
Thanks!
pls try with below code
Public Function getColumn(headerText As String)
str1 = Split(headerText, vbCrLf)
str2 = UBound(str1)
b = Range("1:1").Find(str1(0) & Chr(10) & str1(1)).Column
End Function
Here's the thing: text with and without line break is NOT the same text hence the .Find fail. What you should do is a pattern lookup. I have just tested this and it works, provided that if there is no line break there shall be a space:
Sub test()
Dim rex As RegExp, ran As Range
Dim col As Integer, headerText As String
'read you headerText here
Set rex = New RegExp
rex.Pattern = RegexIt(headerText)
For Each ran In Range("1:1")
If rex.test(ran.Text) Then
col = ran.Column
Exit For
End If
Next ran
MsgBox col
End Sub
Function RegexIt(what As String) As String
what = Replace(what, "(", "\(")
what = Replace(what, ")", "\)")
what = Replace(what, "[", "\[")
what = Replace(what, "]", "\]")
what = Replace(what, "<", "\<")
what = Replace(what, ">", "\>")
what = Replace(what, " ", "[\n ]?")
what = Replace(what, vbCrLf, "[\n ]?")
End Function
Good luck!
Edit: Reference to Microsoft VBScript Regular Expressions 5.5 required
Edit2: Edited for variable use. Explanation: Replace space in variable value with optionel space/line break, escape brackets for pattern matching.
Your code should work even if the header cell contains carriage returns:
Sub FindColumnWithTextInRowOne()
Dim headerText As String, newCol As Long
headerText = "whatever"
newCol = Range("1:1").Find(headerText).Column
MsgBox newCol
End Sub
This is because your use of Find() does not require a match to the WHOLE contents of the cell.
EDIT#1:
If the header cell was constructed using a formula, then a slightly different Find() should be used:
Sub FindColumnWithTextInRowOne()
Dim headerText As String, newCol As Long, r As Range
headerText = Range("H1").Text
newCol = Range("1:1").Find(What:=headerText, LookAt:=xlWhole, LookIn:=xlValues).Column
MsgBox newCol
End Sub
I've got a column which contains rows that have parameters in them. For example
W2 = [PROD][FO][2.0][Customer]
W3 = [PROD][GD][1.0][P3]
W4 = Issues in production for customer
I have a function that is copying other columns into another sheet, however for this column, I need to do the following
Search the cell and look for [P*]
The asterisk represents a number between 1 and 5
If it finds [P*] then copy P* to the sheet "Calculations" in column 4
Basically, remove everything from the cell except where there is a square bracket, followed by P, a number and a square bracket
Does anyone know how I can do this? Alternatively, it might be easier to copy the column across and then remove everything that doesn't meet the above criteria.
Second Edit:
I edited here to use a regular expression instead of a loop. This may be the most efficient method to achieve your goal. See below and let us know if it works for you:
Function MatchWithRegex(sInput As String) As String
Dim oReg As Object
Dim sOutput As String
Set oReg = CreateObject("VBScript.RegExp")
With oReg
.Pattern = "[[](P[1-5])[]]"
End With
If oReg.test(sInput) Then
sOutput = oReg.Execute(sInput)(0).Submatches(0)
Else
sOutput = ""
End If
MatchWithRegex = sOutput
End Function
Sub test2()
Dim a As String
a = MatchWithRegex(Range("A1").Value)
If a = vbNullString Then
MsgBox "None"
Else
MsgBox MatchWithRegex(Range("A1").Value)
End If
End Sub
First EDIT:
My solution would be something as follows. I'd write a function that first tests if the Pattern exists in the string, then if it does, I'd split it based on brackets, and choose the bracket that matches the pattern. Let me know if that works for you.
Function ExtractPNumber(sInput As String) As String
Dim aValues
Dim sOutput As String
sOutput = ""
If sInput Like "*[[]P[1-5][]]*" Then
aValues = Split(sInput, "[")
For Each aVal In aValues
If aVal Like "P[1-5][]]*" Then
sOutput = aVal
End If
Next aVal
End If
ExtractPNumber = Left(sOutput, 2)
End Function
Sub TestFunction()
Dim sPValue As String
sPValue = ExtractPNumber(Range("A2").Value)
If sPValue = vbNullString Then
'Do nothing or input whatever business logic you want
Else
Sheet2.Range("A1").Value = sPValue
End If
End Sub
OLD POST:
In VBA, you can use the Like Operator with a Pattern to represent an Open Bracket, the letter P, any number from 1-5, then a Closed Bracket using the below syntax:
Range("A1").Value LIke "*[[]P[1-5][]]*"
EDIT: Fixed faulty solution
If you're ok with blanks and don't care if *>5, I would do this and copy down column 4:
=IF(ISNUMBER(SEARCH("[P?]",FirstSheet!$W2)), FirstSheet!$W2, "")
Important things to note:
? is the wildcard symbol for a single character; you can use * if you're ok with multiple characters at that location
will display cell's original value if found, leave blank otherwise
Afterwards, you can highlight the column and remove blanks if needed. Alternatively, you can replace the blank with a placeholder string.
If * must be 1-5, use two columns, E and D, respectively:
=MID(FirstSheet!$W2,SEARCH("[P",FirstSheet!$W2)+2,1)
=IF(AND(ISNUMBER($E2),$E2>0,$E2<=5,MID($W2,SEARCH("[P",FirstSheet!$W2)+3,1))), FirstSheet!$W2, "")
where FirstSheet is the name of your initial sheet.
How to create a random sentence in word using VBA?
For example the code beneath created a sentence the cat sat on the mat1.
I would like to declare words in place of i.
Is it possible using VBA?
Sub Randomsentence()
Dim text As String
Dim s As String
MyText = "The cat sat on the"
i = Int(4 * Rnd())
Selection.TypeText (MyText)
Selection.TypeText (i)
End Sub
The following declafres an array and fills it with words. Then a random word is selected from the array and added to the sentence (shown as MsgBox for simplicity):
Sub Randomsentence()
Dim MyText As String
Dim s(5) As String
Dim i As Integer
s(1) = "mat"
s(2) = "floor"
s(3) = "roof"
s(4) = "car"
s(5) = "garage"
MyText = "The cat sat on the "
i = Int(5 * Rnd())
MsgBox MyText & s(i)
End Sub
A maybe nicer way to do that is to read the words from a file. I leave that to you as a nice excercise.
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.