A sample of the record type is
Name Joe Bloggs
eMail joeb...@someeher.com
Address1 11 High Street
Address2
Town Somewhere
PostCode SM1 1WE
Phone 01555 123 4567
-------------------------------
Name Joe Smith
eMail joes...@somewhere.com
Address1 22 The Avenue
Address2
Town Somewhere
PostCode SM1 1WE
Phone 01555 123 4567
--------------------------------
I would like to import and convert these to look like this
Name email Address1 etc...
Joe Bloggs joeb...@somewhere.com 11 High Street etc...
Joe Smith joes...@somewhere.com 22 The Avenue etc...
Can anyone help me please ?
Thanks in advance
Andy M
You don't say what form the original data is in. Is it Excel, CSV,
Tab-Delimited, etc.?
Vasant.
"Andy-UK" <an...@annes-walk.demon.co.uk> wrote in message
news:6100322c.01090...@posting.google.com...
Andy
"Vasant Nanavati" <vas...@aol.com> wrote in message news:<OBNoWpyMBHA.1620@tkmsftngp05>...
Public Sub NAddr8FSS()
'modified 2001-09-02 from Naddr3SS to split descriptive title from data
'Convert 1-Up Name and Address labels to Spread Sheet format.
'David McRitchie http://www.geocities.com/davemcritchie/excel/excel.htm
' 1999-03-01 http://www.geocities.com/davemcritchie/excel/naddr2ss.txt
' 2001-04-10 http://www.geocities.com/davemcritchie/excel/code/naddr3ss.txt
' description: http://www.geocities.com/davemcritchie/excel/snakecols.htm
' modified for max of default 3 lines per input label
Dim nCol As Long, nRow As Long
Dim cRow As Long
Dim lastrow As Long
Dim wsSource As Worksheet
Dim wsNew As Worksheet
Dim linesPerSet As Variant 'Number of rows per label on input
linesPerSet = 8
nCol = 0
nRow = 1
lastrow = Cells.SpecialCells(xlLastCell).Row
Set wsSource = ActiveSheet
Set wsNew = Worksheets.Add
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'xl95 uses xlManual'Application.DisplayAlerts = False
'---- modified to include title from 1st word of 1st set of lines
For cRow = 1 To linesPerSet
wsNew.Cells(1, cRow).Value = PartOne(wsSource.Cells(cRow, 1).Value)
Next cRow
nRow = 2
For cRow = 1 To lastrow
If linesPerSet = nCol Then
nRow = nRow + 1
nCol = 1
Else
nCol = nCol + 1
End If
wsNew.Cells(nRow, nCol).Value = PartTwo(wsSource.Cells(cRow, 1))
Next cRow
Cells.EntireColumn.AutoFit
Application.Calculation = xlCalculationAutomatic 'xl95 uses xlAutomatic
Application.ScreenUpdating = True
End Sub
Function PartOne(pStr As String) As String
If InStr(1, pStr, " ", 0) = 0 Then
PartOne = pStr
Else
PartOne = Left(pStr, InStr(1, pStr, " ", 0) - 1)
End If
End Function
Function PartTwo(pStr As String) As String
If InStr(1, pStr, " ", 0) = 0 Then
PartTwo = ""
Else
PartTwo = Trim(Mid(pStr, InStr(1, pStr, " ", 0) + 1))
End If
End Function
HTH,
David McRitchie, Microsoft MVP - Excel
My Excel Macros: http://www.geocities.com/davemcritchie/excel/excel.htm
Search Page: http://www.geocities.com/davemcritchie/excel/search.htm
"Andy-UK" <an...@annes-walk.demon.co.uk> wrote in message news:6100322c.01090...@posting.google.com...