Hi Paul, Yeah its working fine....U did a great Job...Thanks for ur time.
On Sun, Apr 11, 2010 at 9:20 PM, paulwillekens < paul.johan.willek...@gmail.com> wrote: > 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. > -- ---------------------------------------------------------------------------------- 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
