Related:
- Excel Macro Help Needed
- Spell number in excel without macro - Guide
- Macro excel download - Download - Spreadsheets
- Excel date format dd.mm.yyyy - Guide
- Excel free download - Download - Spreadsheets
- Excel marksheet - Guide
2 responses
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
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.
Ivan
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.
Ivan
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
Else
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
Jul 24, 2008 at 04:51 AM
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!
Jeremy