Excel - Extract numeric from text string

Hi,

I need help to find the solution on how to set excel vba code to
extract 6 digits numeric value ( ie it may start at zero value follow
by the number or no number given ) from text string

E.g.

VBA codes look for 6 digits numeric value from column F and extract it
to column J

Column
F
Column J
a) CIMB - DA dd 11/12/09 - Underpaid for cheque : 632005 dd 10/12/09
-----> 632005
b) HSBC - CA dd 7/12/09 - Overpaid for cheque : 005946 dd 03/12/09
------> 005946
c) RHB - Expiry chq tsfr to unclaimed a/c - 329720 dd 1/6/09 - Leeyana
------> 329720
d) PBB - Expiry chq tsfr to unclaimed a/c - 090813 dd 10/3/09 - Yap KC
-----> 090813
e) UHB - DA dd 17/12/09 - Underpaid for cheque dd 14/12/09
---------------------> blank

Any helps will be appreciated and thanks in advance

Regards
Len

Try this:

Sub GetNumber()
Dim v As String, s1 As String, s2 As String
Dim l As Integer, ll As Integer
Dim r As Range, rr As Range
Set r = Intersect(ActiveSheet.UsedRange, Range("F:F"))
For Each rr In r
v = rr.Value
l = Len(v)
s2 = ""
For ll = 1 To l
s1 = Mid(v, ll, 1)
If IsNumeric(s1) Then
s2 = s2 & s1
If Len(s2) = 6 Then
rr.Offset(0, 4).NumberFormat = "@"
rr.Offset(0, 4).Value = s2
Exit For
End If
Else
s2 = ""
End If
Next
Next
End Sub
--
Gary''s Student - gsnu201001

Something along the lines of

Function Ndigits(s As String, idx As Integer, N As Integer) As String
Dim count As Integer
count = 0
For i = idx To Len(s)
ch = Mid$(s, i, 1)
If IsNumeric(Mid$(s, i, 1)) Then
count = count + 1
If count >= N Then
Ndigits = Mid$(s, i + 1 - count, count)
Exit Function
End If
Else
count = 0
End If
Next i
Ndigits = ""
End Function

Subject to typos. Ought to do it.

Regards,
Martin Brown

Using Regular Expressions:

For a UDF, which can be placed in any cell and refer to any cell:

e.g.  =Get6Digit(F1)

===========================================
Option Explicit
Function Get6Digit(s As String) As String
Dim re As Object, mc As Object
Set re = CreateObject("vbscript.regexp")
re.Pattern = "\b\d{6}\b"
If re.test(s) = True Then
Set mc = re.Execute(s)
Get6Digit = mc(0).Value
End If
End Function
============================================

For a Macro, which can be coded to work on a particular range of cells:

=============================================
Option Explicit
Sub Move6Digits()
Dim rSrc As Range, rDest As Range, c As Range
Dim re As Object, mc As Object
Dim s As String
Set re = CreateObject("vbscript.regexp")
Set rSrc = Range("F1", Cells(Rows.Count, 6).End(xlUp))
Set rDest = Range("J1")

re.Pattern = "\b\d{6}\b"
For Each c In rSrc
rDest(1, 1).Value = ""
rDest(1, 1).NumberFormat = "@"
s = c.Value
If re.test(s) = True Then
Set mc = re.Execute(s)
rDest(1, 1).Value = mc(0).Value
End If
Set rDest = rDest(2, 1)
Next c
End Sub
===============================================

The Pattern "\b\d{6}\b" in each case looks for the first set of 6 consecutive
digits that exists as a stand-alone word.
--ron

Hi Gary's student, Ron & Martin

Many Thanks, you all great !

It works perfectly except that Martin's excel function: =Ndigits(),
how does it work ?



Regards
Len