[Solved] How to stop second run of the code to prevent override data regex vba?

by


One way to tell if the entry has been previously split is as follows

  • If the regex.test fails, then
    • If the results line passes, then the item has been previously split
    • if not, then it is a blank, or a malformed entry

Note that a lot of this could be avoided if you were not overwriting your original data. I would recommend against overwriting your data both for audit and debugging purposes, but the below should help in case you cannot change that.

You just need to make some small changes in the logic where we checked for the malformed entry originally. As well as reading in the “possible” results array into vSrc so that we have the potentially split data to compare:

Option Explicit
Sub Fabrics()
    'assume data is in column A
    Dim wsSrc As Worksheet, wsRes As Worksheet
    Dim vSrc As Variant, vRes As Variant, rRes As Range
    Dim RE As Object, MC As Object
    Const sPat As String = "^(.{6})\s*(.{5})\s*(.{4})(?:.*1/(\S+))?"
        'Group 1 = style
        'Group 2 = fabric
        'Group 3 = colour
        'Group 4 = size
    Dim colF As Collection, cF As cFabric
    Dim I As Long
    Dim S As String
    Dim V As Variant

'Set source and results worksheets and ranges
Set wsSrc = ActiveSheet
Set wsRes = ActiveSheet
    Set rRes = Selection

'Read source data into array
vSrc = Selection.Resize(columnsize:=4)

'Initialize the Collection object
Set colF = New Collection

'Initialize the Regex Object
Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = False
    .MultiLine = True
    .Pattern = sPat

    'iterate through the list

'Test for single cell
If Not IsArray(vSrc) Then
    V = vSrc
    ReDim vSrc(1 To 1, 1 To 1)
    vSrc(1, 1) = V
End If

For I = 1 To UBound(vSrc, 1)
    S = vSrc(I, 1)
    Set cF = New cFabric
    If .test(S) = True Then
        Set MC = .Execute(S)
        With MC(0)
            cF.Style = .submatches(0)
            cF.Fabric = .submatches(1)
            cF.Colour = .submatches(2)
            cF.Size = .submatches(3)
        End With

    ElseIf .test(vSrc(I, 1) & vSrc(I, 2) & vSrc(I, 3)) = False Then
        cF.Style = S
    Else
        cF.Style = vSrc(I, 1)
        cF.Fabric = vSrc(I, 2)
        cF.Colour = vSrc(I, 3)
        cF.Size = vSrc(I, 4)
    End If
    colF.Add cF
Next I
End With

'create results array
'Exit if not results
If colF.Count = 0 Then Exit Sub

ReDim vRes(1 To colF.Count, 1 To 4)

'Populate
I = 0
For Each V In colF
    I = I + 1
    With V
        vRes(I, 1) = .Style
        vRes(I, 2) = .Fabric
        vRes(I, 3) = .Colour
        vRes(I, 4) = .Size
    End With
Next V

'Write the results
Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2))
With rRes
    .Clear
    .NumberFormat = "@"
    .Value = vRes
    .EntireColumn.AutoFit
End With

End Sub

5

solved How to stop second run of the code to prevent override data regex vba?