extract a portion of data from a cell and paste back into same cel

[Peruanos72]

Hello, I have the following code to extract a portion of data from a cell and
place the extracted data back into the same cell. I copied the code from a
posting i saw in the forum and modified it. It works however only when the
cells needing to be changed are grouped together in the column. The cells
needing to be changed are actually seperated by blank cells and cells with
various types of data. The line needing changed is the one that includes the
word "TEAM:".

How can I change only those cells? thx in advance

i.e.

MAILBOX STATUS REPORT
: AENOEL TEAM: ** ALL TEAMS ** (change to AENOEL)

EVIEW FLEX AUDIT MESSAG PEND OTHER TOTAL



2 0 0 0 7 6 21

MAILBOX STATUS REPORT
: ALLUSERS TEAM: ** ALL TEAMS ** (Change to ALLUSERS)

EVIEW FLEX AUDIT MESSAG PEND OTHER TOTAL

2 0 0 0 0 0 2



2 0 0 0 0 0 2

MAILBOX STATUS REPORT
: ALMCCALE TEAM: ** ALL TEAMS ** (Change to ALMCCALE)

EVIEW FLEX AUDIT MESSAG PEND OTHER TOTAL

0 0 0 2 0 67 78

 

[JLGWhiz]

Is the data in a merged cell, and if not, what column is the cell in?

 

[Peruanos72]

it's in column "G". I meant to paste the code i had so you'd have something
to work with but it's past the time i'm authorized to acces my company's
network so i won't be able to post it until tomorrow. sorry about that.

 

[Rick Rothstein]

Give this macro a try....

Sub GetTeam()
Dim X As Long
Dim LastRow As Long
Dim TeamWordPosition As Long
With Worksheets("Sheet4")
LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
For X = 1 To LastRow
TeamWordPosition = InStr(.Cells(X, "G").Value, "Team:")
If TeamWordPosition > 0 Then
.Cells(X, "G").Value = Trim(Left(.Cells(X, "G").Value, _
TeamWordPosition - 1))
End If
Next
End With
End Sub

 

[Peruanos72]

The code executes but no changes are made.

This is the code I'm using. Again, this code only works
when the cells in the column needing to be changed are
grouped together.

code used:

Sub split_text()
Dim data As Variant
Dim ws As Worksheet
Dim i As Long
Dim LastRow As Long
Set ws = Worksheets("MBS Report_all group_non_bl (2)")
LastRow = ws.Cells(Rows.Count, "G").End(xlUp).Row
For i = 1 To LastRow
data = Split(Range("G" & i).Value, " ")
ws.Range("G" & i) = data(1)

Next
End Sub


It works when grouped together like this with no spaces or cells with
different data.

: ALMCCALE TEAM: ** ALL TEAMS **
: ALMCCALE TEAM: ** ALL TEAMS **
: ALMCCALE TEAM: ** ALL TEAMS **
: ALMCCALE TEAM: ** ALL TEAMS **
: ALMCCALE TEAM: ** ALL TEAMS **
: ALMCCALE TEAM: ** ALL TEAMS **

 

[Rick Rothstein]

My fault (I think)... I accidentally used "Team:" instead of "TEAM:" in my
InStr function. Try this revised code (where I am also actually using the
worksheet name you have now posted).

Sub GetTeam()
Dim X As Long
Dim LastRow As Long
Dim TeamWordPosition As Long
With Worksheets("MBS Report_all group_non_bl (2)")
LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
For X = 1 To LastRow
TeamWordPosition = InStr(.Cells(X, "G").Value, "TEAM:")
If TeamWordPosition > 0 Then
.Cells(X, "G").Value = Trim(Left(.Cells(X, "G").Value, _
TeamWordPosition - 1))
End If
Next
End With
End Sub

By the way, I used "TEAM:" and not just " " (space) for my InStr search just
in case the text in front of the word "TEAM:" was composed of more than one
word.

 

[Peruanos72]

That did it. Thanks rick. Here comes a little green check. Have a great
weekend.