andybrooke
asked on
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
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
What should the result be for, say, "58 YBS1 QWS/ENQ/1501510 BGC 1234XYZ5678"?
ASKER
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
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
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:
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
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
' For more info, please see:
' 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 Answer()
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 0: Answer(Counter) = TheMatches(Counter)
Case 1: Answer(Counter) = TheMatches(Counter).FirstIndex + 1
Case 2: Answer(Counter) = TheMatches(Counter).Length
End Select
Next
RegExpFind = Answer
' 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
' For more info, please see:
' 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
' instead
' 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)
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
Thanks, Andy. Glad it worked.
Open in new window