Excel Macro Help Needed

jembuoy - Jul 23, 2008 at 01:53 AM
 Jamie - Oct 17, 2008 at 12:34 PM
Hello Everyone!

I hope you can help me with this...

I have this in my data let's say on column A:

John Doe
1234 Good St
Fax: 650/123-1235
Email: johndoe@gmail.com
web: www.johndoe.com

Jane Doe
1234 Bad St
Email: johndoe@gmail.com
web: www.johndoe.com

Then I want them to be transferred/modified horizontally on the same worksheet but on different columns with headers:

Name Street City and ZC Phone Number Fax email web

How do I do it with macros, considering that every bundle of data per person has different row counts (some have phone number some dont) and they are all separated by a row (in excel).

I hope you can help me please.


2 replies

Ivan-hoe Posts 433 Registration date Saturday February 16, 2008 Status Member Last seen October 17, 2008 110
Jul 24, 2008 at 01:38 AM
Hello Jeremy,
the macro below could do nicely, but with no guarantee
each line in a bundle of data has to be identified to determine in which column it has to be transferred :
- if it contains a header word followed by colon (Fax: Web:) , this header word is used for identification
- for lack of a header, it is considered that each line will be transferred horizontally in the same order (i.e. name / address / city / phone number). If it is not true, then we'll have to review our plans.
Sub Jembuoy()
    Dim LastLine As Integer, i As Integer, ColNbr As Integer
    Dim DataColumn As String
    Dim FirstHeaderColumn As Integer
    Dim MyCell As Range
    Dim Table
    Sheets("Data").Activate 'sheet that contains the data
    DataColumn = "A" 'column that contains the data
    FirstHeaderColumn = 4 'number of the first column that contains a header ("Name")

    LastLine = Cells(Rows.Count, DataColumn).End(xlUp).Row
    Range(DataColumn & "1:" & DataColumn & LastLine).Select
    For Each MyCell In Selection
        If MyCell.Value = Empty Then
            i = 0
            i = i + 1
            Table = Split(MyCell.Value, ":")
            Select Case LCase(Table(0))
                Case Is = "phone": ColNbr = 4
                Case Is = "fax": ColNbr = 5
                Case Is = "email": ColNbr = 6
                Case Is = "web": ColNbr = 7
                Case Else: ColNbr = i
            End Select
            If ColNbr = 1 Then
                LastLine = Cells(Rows.Count, FirstHeaderColumn).End(xlUp).Row + 1
            End If
            Cells(LastLine, FirstHeaderColumn - 1 + ColNbr) = MyCell.Value
        End If
    Next MyCell

End Sub
Dear Ivan- hoe,

Got your message and will try at home. I will send you a feedback once I've tested this but for now please accept my huge thanks and appreciation!

Im doing the exact same thing, except I dont understand the instructions!!! heeelllpppp