根据条件将单元格复制并粘贴到下一列

Question

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

Answer 1

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)

Answer 2

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 Function (Visual Basic)

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.

Answer 3

Try something like this

Else
    Selection.Copy
    Selection.Offset(1, 0).Select
    ActiveSheet.Paste
End If