Extracting a specific structure of a number from a cell-CodePudding

I could not find a solution for my issue and would appreciate your assistance here.

In column A, I have different text in each cell. In between the text within a cell, there is a number in a specific structure - "####.##.####"

I would like to copy this number (if it exists) and copy it to column B in the same line. *If there is more than one number with the above structure in the same cell, the next numbers should be copied to column C, D, E etc. on the same line.

Sub findValues()
    
    Dim loopCounter, lastRow, nextBlank As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
        
    For loopCounter = 1 To lastRow Step 1
        
        With Sheets("Sheet2")
            nextBlank = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
            If Cells(loopCounter, 1).Value Like "[0-9]{4}.[0-9]{2}.[0-9]{4}" Then
                Cells(loopCounter, 2) = 1
            End If
        End With

    Next loopCounter
    
End Sub

CodePudding user response：

Split Column (Loop)

Option Explicit

Sub SplitColumnA()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet2")
    
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim cCell As Range
    Dim Words() As String
    Dim Sentence As String
    Dim r As Long, c As Long, n As Long
    
    For r = 2 To lRow
        Set cCell = ws.Cells(r, "A")
        Sentence = Replace(CStr(cCell.Value), ")", "")
        Words = Split(Sentence)
        For n = 0 To UBound(Words)
            If Words(n) Like "####.##.####" Then
                c = c   1
                cCell.Offset(, c).Value = Words(n)
            End If
        Next n
        c = 0
    Next r
    
    MsgBox "Data split.", vbInformation
    
End Sub