I am trying to paste the cell contents based on a condition that if there is no match then copy the first word of the cell and paste it to the next cell to the right but it gives me object not defined error.
CENTRUM ADVANCE TABLET should copy only CENTRUM
Below is my code
Sub splitUpRegexPattern()
Dim re As Object, c As Range
Dim allMatches
Dim cell As Object
Dim count As Integer
count = 0
For Each cell In Selection
count = count + 1
Next cell
' MsgBox count & " item(s) selected"
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "((\d+(?:\.\d+)?)\s*(m?g|mcg|ml|IU|MIU|mgs|µg|gm|microg|microgram)\b)"
re.IgnoreCase = True
re.Global = True
For Each c In ActiveSheet.Range("D2", ActiveSheet.Range("D2").End(xlDown)).Cells ' Select the range and run the code
Set allMatches = re.Execute(c.Value)
If allMatches.count > 0 Then
c.Offset(0, 1).Value = allMatches(0)
Else
Selection.Copy
c.Offset(0, 1).Value.Paste
End If
Next c
End Sub
A couple changes I believe you need to make:
c.Copy
c.Offset(0, 1).PasteSpecial
There's no paste property of a value. c is a Range so it has Copy and Paste methods.
For your other question:
Dim LArray() As String
LArray = Split(c.Text, " ")
c.Offset(0, 1).Item(1, 1).Value = LArray(0)
Work with split function, Example
Set allMatches = re.Execute(c.Value)
If allMatches.count > 0 Then
c.Offset(0, 1).Value = allMatches(0)
Else
c.Offset(0, 1).Value = Split(c.Value, " ")(0)
End If
Split (text_string, delimiter, limit, compare)
text_string:
Would be C.Value
.
delimiter:
delimiter would be space character (" ").
limit:
leave the limit
argument blank because we need to separate out all the words from C.Value
.
compare:
This would be blank, as blank specifies binary comparison method.
Try something like this
Else
Selection.Copy
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.