Is there a formula that will extract only 8 to 10 digits in a cell?
I have a scenario with thousands of cells in a column that is a summary of words but I need to pull out just the policy numbers that can range from 8-10 digit numbers.
Thanks!
Is there a formula that will extract only 8 to 10 digits in a cell?
I have a scenario with thousands of cells in a column that is a summary of words but I need to pull out just the policy numbers that can range from 8-10 digit numbers.
Thanks!
The code below will extract a number like you describe - 8 to 10 digits - but only the first such number encountered. Install it in a standard code module.
Function ExtractNumber(Txt As String) As String
' 15 Jan 2019
Dim Fun As String
Dim Ch As String, Ln As Integer
Dim n As Integer
For n = 1 To Len(Txt)
Ch = Mid(Txt, n, 1)
If IsNumeric(Ch) Then
Fun = Fun & Ch
Else
Ln = Len(Fun)
If (Ln >= 8) And (Ln <= 10) Then Exit For
Fun = ""
End If
Next n
Ln = Len(Fun)
If (Ln >= 8) And (Ln <= 10) Then ExtractNumber = Fun
End Function
My first idea was to let it work as a UDF. So, I programmed a UDF procedure to call it.
Function PolNum(Cell As Range) As String
' 05 Jan 2019
PolNum = ExtractNumber(CStr(Cell.Value))
End Function
Install this function in the same standard code module as the one that does the work. Enter =PolNum($K2) in cell S2 and copy down. Make sure that S2 is formatted as Text. Otherwise you will lose leading zeroes.
Then I thought that this UDF will slow down your sheet quite a bit. Also, I don't much like UDFs because they have a tendency not to update just whenever you have started to trust that they do. The alternative is an event procedure which fires when a change is made in column K. Install the code in the code module of the worksheet on which you want the action.
Private Sub Worksheet_Change(ByVal Target As Range)
' 05 Jan 2019
Const FirstDataRow As Long = 2
Const TargetClm As String = "K"
Const ResultClm As String = "T"
Dim Rng As Range
With Target
On Error Resume Next
If .Cells.Count = 1 Then ' ignore multiple cell changes
If Err Then Exit Sub
On Error GoTo 0
Set Rng = Range(Cells(FirstDataRow, TargetClm), _
Cells(Rows.Count, TargetClm).End(xlUp))
If Not Application.Intersect(Target, Rng) Is Nothing Then
Application.EnableEvents = False
Cells(.Row, ResultClm).Value = ExtractNumber(CStr(.Value))
Application.EnableEvents = True
End If
End If
End With
End Sub
Set the 3 constants at the top of the code to the values that match your worksheet, remember to format the target column as Text, and observe that the procedure calls the same ExtractNumber function first above mentioned. So, in theory, you could have both the UDF and the event procedure in your workbook, although it's easier to imagine the harm that might do than the good.
Unless you wish to avoid changing several thousand cells in order to trigger several thousand events. I would use a loop to call ExtractNumber for all rows before first use but an alternative would be to install the UDF calls and copy/paste values.
Edit Jan 15, 2019 ================================
I now attach a workbook containing the above code. In the process of preparing it I found that the function ExtractNumber failed to return numbers found at the end of the string. This was corrected and the revised function published above.