Copy Certain Text to Empty Cell

pdmken

New Member
Joined
Sep 16, 2014
Messages
2
I am working on a data feed and need to add some text to individual columns. I need to copy part of the contents from column F to column G with all text to the left of word tablet PC. What's to the left maybe manufacturer and model number. Some of the cells don't have the word tablet PC and can be manually entered.

Using Excel 2007
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
.
.

Try something like this:

Code:
Sub CopyRange()

    Dim rng As Range
    Dim txt As String
    Dim cell As Range
    Dim pos As Byte
    
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
    With ActiveSheet
        On Error Resume Next
        Set rng = Intersect(.Columns("F"), .UsedRange)
        On Error GoTo 0
    End With
    
    If Not rng Is Nothing Then
        txt = "tablet pc"   'text to search for
        For Each cell In rng
            pos = InStr(LCase(cell.Value), LCase(txt))
            With cell.Offset(0, 1)
                Select Case pos
                    Case Is = 0: .Value = vbNullString
                    Case Else: .Value = Trim(Left(cell.Value, pos - 1))
                End Select
            End With
        Next cell
    End If

End Sub
 
Upvote 0
.
.

Try something like this:

Code:
Sub CopyRange()

    Dim rng As Range
    Dim txt As String
    Dim cell As Range
    Dim pos As Byte
    
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
    With ActiveSheet
        On Error Resume Next
        Set rng = Intersect(.Columns("F"), .UsedRange)
        On Error GoTo 0
    End With
    
    If Not rng Is Nothing Then
        txt = "tablet pc"   'text to search for
        For Each cell In rng
            pos = InStr(LCase(cell.Value), LCase(txt))
            With cell.Offset(0, 1)
                Select Case pos
                    Case Is = 0: .Value = vbNullString
                    Case Else: .Value = Trim(Left(cell.Value, pos - 1))
                End Select
            End With
        Next cell
    End If

End Sub

Worked perfectly, thanks
 
Upvote 0
Here is a shorter macro that should also work for you...
Code:
Sub CopyRange()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "F").End(xlUp).Row
  Range("G1:G" & LastRow) = Evaluate(Replace("IF(ISNUMBER(SEARCH(""tablet pc"",F1:F#)),TRIM(" & _
                            "LEFT(F1:F#,SEARCH(""tablet pc"",F1:F#)-1)),"""")", "#", LastRow))
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,267
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top