Hi Kevin,
Here the macro...
Feedback please...
Kind Regards,
Paul Willekens
'=======================================================================
Sub Reformat()
Dim cAddress
Dim cCity
Dim cCompany
Dim cEmail
Dim cName
Dim cPhone
Dim cState
Dim cTitle
Dim nPos
Dim nRowIn
Dim nRowOut
nRowIn = 2
nRowOut = 2
Sheets("Sheet1").Activate
While Len(Cells(nRowIn, 1).Value) > 0
cName = Cells(nRowIn, 1).Value
cCompany = Cells((nRowIn + 2), 1).Value
cPhone = Cells(nRowIn, 2).Value
cAddress = Cells((nRowIn + 1), 2).Value
cCity = Cells((nRowIn + 2), 2).Value
nPos = InStr(cCity, ",")
If nPos > 0 Then
cState = Mid(cCity, (nPos + 2), 2)
Else
cState = ""
End If
cTitle = Cells(nRowIn, 3).Value
cEmail = Cells((nRowIn + 1), 3).Value
Sheets("Sheet2").Activate
Cells(nRowOut, 1).Value = cName
Cells(nRowOut, 2).Value = cCompany
Cells(nRowOut, 3).Value = cAddress
Cells(nRowOut, 4).Value = cCity
Cells(nRowOut, 5).Value = cState
Cells(nRowOut, 6).Value = cEmail
Cells(nRowOut, 7).Value = cPhone
nRowOut = nRowOut + 1
nRowIn = nRowIn + 3
Sheets("Sheet1").Activate
Wend
MsgBox "Done with row " & (nRowIn - 1)
End Sub
'=======================================================================
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,800 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
