Hi Anju,
Of cours, you give too few examples, but at least for the two formats
following macro shoud do the job.
Give some feedback.
Kind regards,
Paul Willekens
'=======================================================================
Sub PullNumber()
Dim cChar
Dim cContent
Dim cNumber
Dim lFount
Dim nLen
Dim nPos
Dim nPosNum
Dim nRow
Dim nStart
nRow = 1
While Len(Cells(nRow, 1).Value) > 0
cContent = Cells(nRow, 1)
nLen = Len(cContent)
cNumber = ""
For nPos = 1 To nLen
cChar = Mid(cContent, nPos, 1)
If IsNumeric(cChar) Then
nPosNum = nPos
While nPosNum <= nLen And IsNumeric(Mid(cContent, nPosNum, 1))
cNumber = cNumber & Mid(cContent, nPosNum, 1)
nPosNum = nPosNum + 1
Wend
'check for special number AAAA######-#
If nPosNum < nLen And nPos > 4 _
And Not Mid(cContent, (nPos - 1), 1) = " " Then
cNumber = Mid(cContent, (nPos - 4), 4) & cNumber & "-"
nPosNum = nPosNum + 1
While nPosNum <= nLen And IsNumeric(Mid(cContent, nPosNum, 1))
cNumber = cNumber & Mid(cContent, nPosNum, 1)
nPosNum = nPosNum + 1
Wend
End If
nPos = nLen
End If
Next
If Not cNumber = "" Then
Cells(nRow, 2).Value = cNumber
End If
nRow = nRow + 1
Wend
MsgBox "Done at row " & (nRow - 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 Facebook Group @ http://www.facebook.com/group.php?gid=287779555678
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
To unsubscribe, reply using "remove me" as the subject.
