Transfer data from Excel col. A to columns B-E in the same sheet

J

JackGombola

I have an Excel 2003 spreadsheet with only one column of player data: column
A. The first three data items in column A are the same for every player:
Name, Address and Phone. Every player also has at least one comment but
could have any number of comments. Each player’s data is separated from the
next by a blank cell in column A. Sometimes, a player’s last few comments are
blank resulting in multiple blank cells in column A before the data for the
next player starts.

I need help writing an Excel 2003 VBA macro to:
1. Copy just the player’s name, but not the Name: label, to column B as shown.
2. Copy just the address, but not the Address: label, to column C
3. Copy just the phone, but not the Phone: label, to D
4. Combine all of the player’s comments, but not the original Comment:
label, into one paragraph and paste into E. Repeat the above process,
ignoring any blank rows separating the players, for all the player data in
column A.
A B C D E
Name:John John Main St 555-1212 Plays 1st base. Plays
2nd
Address:Main St Jane Center St 555-1213 Catches well. Has played
center.
Phone:555-1212
Comment:plays 1st base
Plays 2nd

Name:Jane
Address:Center St
Phone:555-1213
Comment:Catches well
Has played center.

I've been able to do the easy stuff, repositioning the column headings etc.
but the variable number of comments entries is giving me trouble as is
removing the labels and colons:)) that precede the data. I'm guessing that
the latter is done with a find to find the colon:)) but then how do I copy
all the characters to the right?

Thanks is advance for any ideas.
Jack
 
D

Don Guillett

If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.
 
D

Don Guillett

This does it based on sample provided
Sub findnamesSAS()
Dim lr As Long
Dim fr As Long
Dim dr As Long
Dim mr As Range
Dim nr As Long
Dim i As Double
Dim wt As String
Dim mc As String
lr = Cells(Rows.Count, 1).End(xlUp).Row
fr = 1
dr = 2
Application.ScreenUpdating = False
startover:

Set mr = Columns("A").Find(What:="Name:", _
After:=Cells(fr, 1), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)

If Not mr Is Nothing Then
'MsgBox mr.Row
nr = Cells(mr.Row, 1).End(xlDown).Row
'MsgBox nr
For i = 1 To nr - mr.Row + 1
mc = Cells(mr.Row + i - 1, 1)
wt = InStr(mc, ":")
Cells(dr, i + 1) = Right(mc, Len(mc) - wt)
Next i
dr = dr + 1
fr = nr
If nr = lr Then GoTo docolumns
GoTo startover
End If
docolumns:
Columns(2).Resize(, 10).Columns.AutoFit
Application.ScreenUpdating = True
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top