I'm trying to cut out a part of a cell value.

This is how it should look:

So far I got this:

    For Each item In arr
    
    pos = InStr(item, "No")
    
    If pos > 0 Then
    
        ActiveSheet.Range("B" & row).Value = item
        row = row   1
    
    Else
    
        ActiveSheet.Range("B" & row).Value = " N/A "
        row = row   1
    
    End If

This returns me the rows but i still need to cut out the Values

-----Update-----

This is what i have now:

Sub cut()

Call Variables

    Dim arr() As Variant
    Dim element As Variant
    Dim element2 As Variant
    Dim rows As Integer
    Dim rows2 As Integer
    
    arr = Array("test352532_No223", _
                "testfrrf43tw_No345figrie_ge", _
                "test123_No32_fer", _
                "test_Nhuis34", _
                "teftgef_No23564.345")

    With ThisWorkbook.Worksheets("Numbers").Activate

    rows = 1
    rows2 = 1
        
    For Each element In arr
        
        Range("A" & rows).Value = element
 
        With regEx

            .Pattern = "(No[1-9][\.\d] [a-z]?)"
            Set mc = regEx.Execute(element)

            For Each element2 In mc
                
                ActiveSheet.Range("B" & rows2).Value = element2
                rows2 = rows2   1

            Next element2
            
       End With
       
       rows = rows   1
            
    Next element
    
    End With
    
End Sub

And this is what it results:

So the problem is, that the Value in B4 should be in B5...

CodePudding user response：

Formula:

Formula in B1:

=IFERROR("No"&-LOOKUP(1,-MID("_"&SUBSTITUTE(A1,".","|"),FIND("_No","_"&A1) 3,ROW($1:$99))),"")

Notes:

• Add leading _ to allow for match at start of string;
• FIND() is case-sensitive;
• SUBSTITUTE() out the dot to prevent longer match with FIND();
• The above will not work well when 1st digit after No is a zero.

---

VBA:

If VBA is a must, try an UDF, for example:

Function GetNo(s As String) As String

With CreateObject("vbscript.regexp")
    .Pattern = "^(?:.*?_)?(No\d )?.*$"
    GetNo = .Replace(s, "$1")
End With

End Function

On your worksheets in B1, invoke through typing =GetNo(A1).

Here I used regular expressions to 'cut' the substring you are after. See an online demo. The pattern means:

• ^ - Start-line anchor;
• (?:.*?_)? - Optional non-capture group to match 0 (Lazy) characters upto underscore. This would also allow No at start of string;
• (No\d )? - Optional capture group to match No (case-sensitive) followed by 1 digits;
• .* - 0 Characters;
• $ - End-line anchor.

EDIT: You can also call the function in your VBA-project:

Sub Test()

arr = Range("A1:A5").Value
            
For x = LBound(arr) To UBound(arr)
    arr(x, 1) = GetNo(CStr(arr(x, 1)))
Next

Range("B1").Resize(UBound(arr)).Value = arr

End Sub

CodePudding user response：

Please, test the next function:

Function extractNoStr(x As String) As String
  Dim frst As Long, last As Long, i As Long
  frst = InStr(1, x, "No", vbBinaryCompare)
  For i = frst   2 To Len(x)
    If Not IsNumeric(Mid(x, i, 1)) Then last = i: Exit For
  Next i
  If i > Len(x) And last = 0 Then last = Len(x)   1
    extractNoStr = Mid(x, frst, last - frst)
End Function

It can be tested as:

Sub testExtractNoStr()
   Dim x As String
   x = "test2345_No345figrie_ge"

   Debug.Print extractNoStr(x)
   Debug.Print activeCell.value 'select a cell containing such a string...
End Sub

To process all range of column A:A, returning in B:B, please use the next code:

Sub extractAll()
  Dim sh As Worksheet, lastR As Long, arr, arrFin, i As Long
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  arr = sh.Range("A1:A" & lastR).Value2  'place the range in an array for faster processing
  ReDim arrFin(1 To UBound(arr), 1 To 1) 'ReDim the final array to receive all occurrences
  For i = 1 To UBound(arr)
        arrFin(i, 1) = extractNoStr(CStr(arr(i, 1)))
  Next i
  'drop the processed array content, at once:
  sh.Range("B1").Resize(UBound(arrFin), 1).Value2 = arrFin
End Sub