Macro to extract 10 digit number from cell starting with 501

[amandeep08]

Hi All,

I want a Macro that will extract 10 digit number from cell which contains number & alphabets and the number should start from 501. The macro will override that cell with the number and .xlsx

Can someone pl help me

 

[amandeep08]

IN othe case

Sub test()
    Dim a As Variant
    a = Cells(1).CurrentRegion
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "[5][0][1]+\d+"
        For i = 1 To UBound(a)
            Set m = .Execute(a(i, 1))
            If m.Count = 1 Then
                a(i, 1) = m(0)
            Else
                For ii = 0 To m.Count - 1
                    tmp = IIf(tmp = "", "", tmp) & "," & m(ii)
                Next
                a(i, 1) = tmp
                tmp = ""
            End If
        Next
    End With
    Cells(1, 1).Resize(UBound(a)) = a
End Sub

Yes, this is working but can we have .xlsx also after the number

 

[mohadin]

Replace with

   tmp = tmp & IIf(tmp = "", "", ",") & m(ii) & ".xlsx"

 

[Rick Rothstein]

99% cases Number starting with 501 is not possible. If else if it is present and the total digits are 10, in that case, result should be 1st number.xlsx, 2nd number.xlsx
The number should be separated with comma but it will be in a single cell

Give this macro a try (it will handle the multiple 501's should there be any)...

Sub Get501s()
  Dim R As Long, LastRow As Long, XLXS As String, V As Variant, Arr As Variant
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For R = 1 To LastRow
    Arr = Split(Cells(R, "A").Value & " ", 501)
    XLXS = ""
    For Each V In Arr
      If V Like "#######[!0-9]*" Then XLXS = XLXS & ", 501" & Left(V, 7) & ".xlxs"
    Next
    Cells(R, "B").Value = Mid(XLXS, 3)
  Next
End Sub

 

[amandeep08]

T

Give this macro a try (it will handle the multiple 501's should there be any)...

Sub Get501s()
  Dim R As Long, LastRow As Long, XLXS As String, V As Variant, Arr As Variant
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For R = 1 To LastRow
    Arr = Split(Cells(R, "A").Value & " ", 501)
    XLXS = ""
    For Each V In Arr
      If V Like "#######[!0-9]*" Then XLXS = XLXS & ", 501" & Left(V, 7) & ".xlxs"
    Next
    Cells(R, "B").Value = Mid(XLXS, 3)
  Next
End Sub

This is also working but it is taking data to next column instead of replacing the same column

 

[mohadin]

This is also working but it is taking data to next column instead of replacing the same column

Replace
Cells(R, "A").Value = Mid(XLXS, 3)

 

[Rick Rothstein]

This is also working but it is taking data to next column instead of replacing the same column

Whoops! I missed that you wanted the values to replace the existing values. The fix is simple, we just need to change the last line inside the outer For loop. mohadin post the correction; here is the complete code...

Sub Get501s()
  Dim R As Long, LastRow As Long, XLXS As String, V As Variant, Arr As Variant
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For R = 1 To LastRow
    Arr = Split(Cells(R, "A").Value & " ", 501)
    XLXS = ""
    For Each V In Arr
      If V Like "#######[!0-9]*" Then XLXS = XLXS & ", 501" & Left(V, 7) & ".xlxs"
    Next
    Cells(R, "A").Value = Mid(XLXS, 3)
  Next
End Sub

 

[amandeep08]

Thanks a lot for everyone.

The given macros is working fine.

 

[mohadin]

You are very welcome
And thank you for the feedback
Be happy

 

[pomamo]

@Rick Rothstein could you give a variant for this

Hi,
I'm looking for an Excel that is able to extract all consecutive 5-digit numbers from each cell, separating the results with a comma.
Note while extracting, exclude numbers less than 5 digits, exclude numbers more than 5 digits

 

[Rick Rothstein]

@Rick Rothstein could you give a variant for this

Hi,
I'm looking for an Excel that is able to extract all consecutive 5-digit numbers from each cell, separating the results with a comma.
Note while extracting, exclude numbers less than 5 digits, exclude numbers more than 5 digits

Give this UDF a try...

Function FiveDigits(ByVal S As String) As String
  Dim X As Long, Arr As Variant
  For X = 1 To Len(S)
    If Mid(S, X, 1) Like "[!0-9]" Then Mid(S, X) = " "
  Next
  Arr = Split(Application.Trim(S))
  For X = 0 To UBound(Arr)
    If Len(Arr(X)) <> 5 Then Arr(X) = ""
  Next
  FiveDigits = Replace(Application.Trim(Join(Arr)), " ", ", ")
End Function