RegEx Row Column Listing Error

[airforceone]

coming from this thread String Parsing

I was able to convert @Peter_SSs function code to an ordinary procedure. (thanks again @Peter_SSs )

Sub PetListII()
 
  Dim RX As Object, M As Object, RXCtr As Integer
    
    Dim K As Integer, ConfisKated As String, FullName As Variant, MaxNumero() As Integer

    Set WSCopy = ActiveSheet
    ActiveSheet.Select
        
    'Find the last non-blank cell in row 1
    LastRow = Cells(rows.Count, 1).End(xlUp).Row
    'Find the last non-blank cell in COL 1
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
        
    ReDim MaxNumero(LastRow)
'------------------------------
'
'   Count The "," in a string
'   Result will be used for the looping sequence
'
'------------------------------
    For K = 2 To LastRow
        MaxNumero(K) = Len(WSCopy.Range("A" & K)) - Len(Application.WorksheetFunction.Substitute(WSCopy.Range("A" & K), ",", "")) + 1
    Next K
    LastMaxNum = WorksheetFunction.Max(MaxNumero)
 
'------------------------------
'
'   RegEx Pattern
'   by  Peter_SSs
'   @ https://www.mrexcel.com/
'
'------------------------------
    Set RX = CreateObject("VBScript.RegExp")
    RX.Global = True
    RX.Pattern = "([^,]+\*.+?)(\,?)(?=([^,]+\*)|$)"
    
    Set M = RX.Execute(Cells(2, 1))
    RXCtr = 0
    For K = 2 To LastRow
        For iCTR = 2 To LastMaxNum
            Cells(K, iCTR).Value = M(RXCtr).SubMatches(0)
            RXCtr = RXCtr + 1
        Next
    Next
    
End Sub

But got hit by another roadblock. what I'm trying to achieved here is to process all rows and output in their respective cell address.
I think the code

Set M = RX.Execute(Cells(2, 1))

outside of the loop is causing the "Run-time error '5'; Invalid Procedure call or argument" in

Cells(K, iCTR).Value = M(RXCtr).SubMatches(0)

X TEMPLATE.xlsm
	A	B	C	D
1	Entry	RESULT
2	Dog*Brown,White,Black,Dragon*Golden,Green,Red,Black,Eagle*Red,Black,Green	Dog*Brown,White,Black	Dragon*Golden,Green,Red,Black	Eagle*Red,Black,Green
3	Dog*Brown,White,Black,Eagle*Red,Black,Green	Dog*Brown,White,Black	Eagle*Red,Black,Green
4	Dragon*Golden,Green,Red,Black	Dragon*Golden,Green,Red,Black
5	Dog*Brown,White,Black,Dragon*Golden,Green,Red,Black,Eagle*Red,Black,Green	Dog*Brown,White,Black	Dragon*Golden,Green,Red,Black	Eagle*Red,Black,Green
6	Dog*Brown,White,Black,Dragon*Golden,Green,Red,Black,Eagle*Red,Black,Green	Dog*Brown,White,Black	Dragon*Golden,Green,Red,Black	Eagle*Red,Black,Green
StringParsing (3)

 

[Peter_SSs]

until we figure out where is that warning coming from....

Are you able to upload a sample dummy data file where the problem is happening to DropBox/OneDrive/Google Drive etc and provide a shared link here?

 

[airforceone]

Are you able to upload a sample dummy data file where the problem is happening to DropBox/OneDrive/Google Drive etc and provide a shared link here?

here it is @Peter_SSs

Sample Table

Sub Pet_Lists()

    Dim RX As Object
    Dim a As Variant
    Dim i As Long
    
'Application.DisplayAlerts = False
    
    Set RX = CreateObject("VBScript.RegExp")
    RX.Global = True
    RX.Pattern = "(\,)(?=([^,]+\*)|$)"
    With Range("A2", Range("A" & rows.Count).End(xlUp))
      a = .Value
      For i = 1 To UBound(a)
        a(i, 1) = RX.Replace(a(i, 1), ";")
      Next i
      With .Offset(, 1)
        .Resize(, 50).ClearContents
        .Value = a
        .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
      End With
    End With

'Application.DisplayAlerts = True

End Sub

 

[Peter_SSs]

Thanks for the sample file. I probably have, but don't remember striking this issue before but it appears that the message appears because the destination cells have borders.
For example, just as a test, if you make this change then the code runs without disabling alerts and without the pop-up warning.

.Resize(, 50).ClearContents
.Resize(, 50).Clear

However, I assume that you want the borders, so probably the simplest this is to do what you did - disable alerts & re-enable them at the end.

 

[airforceone]

Thanks for the sample file. I probably have, but don't remember striking this issue before but it appears that the message appears because the destination cells have borders.
For example, just as a test, if you make this change then the code runs without disabling alerts and without the pop-up warning.

.Resize(, 50).ClearContents
.Resize(, 50).Clear

However, I assume that you want the borders, so probably the simplest this is to do what you did - disable alerts & re-enable them at the end.

indeed! the border is causing the problem!
Again @Peter_SSs Thanks mate... I'll just issued the border settings after the code

 

[Peter_SSs]

Glad you have it resolved.