# Only showing numbers in cell

Hi,

a previous question I wanted only number to be shown from a field this worked great code sample below. I want to expand on this and only show numbers the are more than 3 digits together.

For example I have have a cell like "58     YBS1    QWS/ENQ/1501510 BGC". From this I would only want 1501510 to show....

Thanks
``````Option Explicit

Function RemoveAlpha(Rng As String) As String
Dim Tmp As String
Dim i As Integer
Dim Alpha As String

Tmp = Rng
'Numbers are 48-57
For i = 1 To 255
If i >= 48 And i <= 57 Then GoTo skip
Alpha = Chr(i)
Tmp = Application.Substitute(Tmp, Alpha, "")
skip:
Next i
RemoveAlpha = Tmp
End Function``````
dsacker

``````Function RemoveAlphaKeep3Digit(ByVal Rng As String) As String
Dim Alpha As String
Dim Char As String
Dim Cnt As Integer
Dim i As Integer
Dim Hold As String

Cnt = 0
Hold = ""
For i = 1 To Len(Rng)
Char = Mid(Rng, i, 1)
Select Case Char
Case "0" To "9"
Cnt = Cnt + 1
Hold = Hold + Char
Case Len(Hold) < 3
Hold = ""
Cnt = 0
Case Else
Alpha = Alpha + Hold
Hold = ""
Cnt = 0
End Select
Next i
If Len(Hold) >= 3 Then
Alpha = Alpha + Hold
End If
RemoveAlphaKeep3Digit = Alpha
End Function``````
dsacker

membership
Create an account to see this answer
Signing up is free. No credit card required.
What should the result be for, say, "58     YBS1    QWS/ENQ/1501510 BGC 1234XYZ5678"?
andybrooke

yes I though of this, unfrotunaley I have to go through those manuall but there isnt masses of them. Thanks dsacker seems to be working great!
Option Explicit

Function RemoveAlpha(Rng As String) As String
Dim Tmp As String
Dim i As Integer
Dim Alpha As String

Dim Left As String
Dim LeftLength As Integer
Dim RightLength As Integer
Dim ExitLoop As Boolean

ExitLoop = False

Tmp = Rng
'Numbers are 48-57
For i = 1 To 255
If i >= 48 And i <= 57 Then GoTo skip
Alpha = Strings.Chr(i)
Tmp = Application.Substitute(Tmp, Alpha, " ")
skip:
Next i

LeftLength = InStr(1, Tmp, " ") - 1
RightLength = Strings.Len(Tmp) - LeftLength

Do While ExitLoop = False
If LeftLength > 3 Then
RemoveAlpha = Strings.Left(Tmp, LeftLength)
ExitLoop = True
Else
Tmp = Strings.Right(Tmp, Strings.Len(Tmp) - LeftLength)
If InStr(1, Tmp, " ") = 1 Then
LeftLength = 1
Else
LeftLength = InStr(1, Tmp, " ") - 1
End If
RightLength = Strings.Len(Tmp) - LeftLength
ExitLoop = False
End If
Loop

RemoveAlpha = Tmp
End Function
andybrooke,

You might also want to consider an approach using Regular Expressions, as outlined here:

https://www.experts-exchange.com/Programming/Languages/Visual_Basic/A_1336-Using-Regular-Expressions-in-Visual-Basic-for-Applications-and-Visual-Basic-6.html

Depending on the exact behavior you want, you can use either the RegExpFind or RegExpReplace functions from that article:

``````Function RegExpFind(LookIn As String, PatternStr As String, Optional Pos, _
Optional MatchCase As Boolean = True, Optional ReturnType As Long = 0, _
Optional MultiLine As Boolean = False)

' Function written by Patrick G. Matthews.  You may use and distribute this code freely,
' as long as you properly credit and attribute authorship and the URL of where you
' found the code

' http://www.experts-exchange.com/articles/Programming/Languages/Visual_Basic/Using-Regular-Expressions-in-Visual-Basic-for-Applications-and-Visual-Basic-6.html

' This function relies on the VBScript version of Regular Expressions, and thus some of
' the functionality available in Perl and/or .Net may not be available.  The full extent
' of what functionality will be available on any given computer is based on which version
' of the VBScript runtime is installed on that computer

' This function uses Regular Expressions to parse a string (LookIn), and return matches to a
' pattern (PatternStr).  Use Pos to indicate which match you want:
' Pos omitted               : function returns a zero-based array of all matches
' Pos = 1                   : the first match
' Pos = 2                   : the second match
' Pos = <positive integer>  : the Nth match
' Pos = 0                   : the last match
' Pos = -1                  : the last match
' Pos = -2                  : the 2nd to last match
' Pos = <negative integer>  : the Nth to last match
' If Pos is non-numeric, or if the absolute value of Pos is greater than the number of
' matches, the function returns an empty string.  If no match is found, the function returns
' an empty string.  (Earlier versions of this code used zero for the last match; this is
' retained for backward compatibility)

' If MatchCase is omitted or True (default for RegExp) then the Pattern must match case (and
' thus you may have to use [a-zA-Z] instead of just [a-z] or [A-Z]).

' ReturnType indicates what information you want to return:
' ReturnType = 0            : the matched values
' ReturnType = 1            : the starting character positions for the matched values
' ReturnType = 2            : the lengths of the matched values

' If you use this function in Excel, you can use range references for any of the arguments.
' If you use this in Excel and return the full array, make sure to set up the formula as an
' array formula.  If you need the array formula to go down a column, use TRANSPOSE()

' Note: RegExp counts the character positions for the Match.FirstIndex property as starting
' at zero.  Since VB6 and VBA has strings starting at position 1, I have added one to make
' the character positions conform to VBA/VB6 expectations

' Normally as an object variable I would set the RegX variable to Nothing; however, in cases
' where a large number of calls to this function are made, making RegX a static variable that
' preserves its state in between calls significantly improves performance

Static RegX As Object
Dim TheMatches As Object
Dim Counter As Long

' Evaluate Pos.  If it is there, it must be numeric and converted to Long

If Not IsMissing(Pos) Then
If Not IsNumeric(Pos) Then
RegExpFind = ""
Exit Function
Else
Pos = CLng(Pos)
End If
End If

' Evaluate ReturnType

If ReturnType < 0 Or ReturnType > 2 Then
RegExpFind = ""
Exit Function
End If

' Create instance of RegExp object if needed, and set properties

If RegX Is Nothing Then Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Pattern = PatternStr
.Global = True
.IgnoreCase = Not MatchCase
.MultiLine = MultiLine
End With

' Test to see if there are any matches

If RegX.Test(LookIn) Then

' Run RegExp to get the matches, which are returned as a zero-based collection

Set TheMatches = RegX.Execute(LookIn)

' Test to see if Pos is negative, which indicates the user wants the Nth to last
' match.  If it is, then based on the number of matches convert Pos to a positive
' number, or zero for the last match

If Not IsMissing(Pos) Then
If Pos < 0 Then
If Pos = -1 Then
Pos = 0
Else

' If Abs(Pos) > number of matches, then the Nth to last match does not
' exist.  Return a zero-length string

If Abs(Pos) <= TheMatches.Count Then
Pos = TheMatches.Count + Pos + 1
Else
RegExpFind = ""
GoTo Cleanup
End If
End If
End If
End If

' If Pos is missing, user wants array of all matches.  Build it and assign it as the
' function's return value

If IsMissing(Pos) Then
ReDim Answer(0 To TheMatches.Count - 1)
For Counter = 0 To UBound(Answer)
Select Case ReturnType
Case 1: Answer(Counter) = TheMatches(Counter).FirstIndex + 1
End Select
Next

' User wanted the Nth match (or last match, if Pos = 0).  Get the Nth value, if possible

Else
Select Case Pos
Case 0                          ' Last match
Select Case ReturnType
Case 0: RegExpFind = TheMatches(TheMatches.Count - 1)
Case 1: RegExpFind = TheMatches(TheMatches.Count - 1).FirstIndex + 1
Case 2: RegExpFind = TheMatches(TheMatches.Count - 1).Length
End Select
Case 1 To TheMatches.Count      ' Nth match
Select Case ReturnType
Case 0: RegExpFind = TheMatches(Pos - 1)
Case 1: RegExpFind = TheMatches(Pos - 1).FirstIndex + 1
Case 2: RegExpFind = TheMatches(Pos - 1).Length
End Select
Case Else                       ' Invalid item number
RegExpFind = ""
End Select
End If

' If there are no matches, return empty string

Else
RegExpFind = ""
End If

Cleanup:
' Release object variables

Set TheMatches = Nothing

End Function

Function RegExpReplace(LookIn As String, PatternStr As String, Optional ReplaceWith As String = "", _
Optional ReplaceAll As Boolean = True, Optional MatchCase As Boolean = True, _
Optional MultiLine As Boolean = False)

' Function written by Patrick G. Matthews.  You may use and distribute this code freely,
' as long as you properly credit and attribute authorship and the URL of where you
' found the code

' http://www.experts-exchange.com/articles/Programming/Languages/Visual_Basic/Using-Regular-Expressions-in-Visual-Basic-for-Applications-and-Visual-Basic-6.html

' This function relies on the VBScript version of Regular Expressions, and thus some of
' the functionality available in Perl and/or .Net may not be available.  The full extent
' of what functionality will be available on any given computer is based on which version
' of the VBScript runtime is installed on that computer

' This function uses Regular Expressions to parse a string, and replace parts of the string
' matching the specified pattern with another string.  The optional argument ReplaceAll
' controls whether all instances of the matched string are replaced (True) or just the first
' instance (False)

' If you need to replace the Nth match, or a range of matches, then use RegExpReplaceRange

' By default, RegExp is case-sensitive in pattern-matching.  To keep this, omit MatchCase or
' set it to True

' If you use this function from Excel, you may substitute range references for all the arguments

' Normally as an object variable I would set the RegX variable to Nothing; however, in cases
' where a large number of calls to this function are made, making RegX a static variable that
' preserves its state in between calls significantly improves performance

Static RegX As Object

If RegX Is Nothing Then Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Pattern = PatternStr
.Global = ReplaceAll
.IgnoreCase = Not MatchCase
.MultiLine = MultiLine
End With

RegExpReplace = RegX.Replace(LookIn, ReplaceWith)

End Function``````

To grab just the first instance of 4+ consecutive digits:

=RegExpFind(A2,"\d{4,}")

To remove all characters from a string except for blocks of 4+ consecutive digits:

=RegExpReplace(A2,"((^|\D)\d{1,3}(\$|\D))|\D")

Note that that second expression seems to be returning the same results as dsacker's code.

The advantage to RegExp is that is is extremely flexible, but to each his/her own :)

Patrick