How to Split Cells and Display Only Worksheet Name?-CodePudding

Is there a clean and tidy way to get cells split ONLY by sheet name? I have a bunch of cells that look something like this.

=(Xlookup($A2,Staff!A:A,Client!K:K)*E2
=B3*(Xlookup(E3,Auto!1:1,Desc!3:3)

And, all kinds of other stuff. Basically, I am trying to parse out only the sheet names from each cell. Each sheet name ends with a '!' character. So, I am trying to split one cell into multiple columns, based on the '!' character, and ignore any text that is not a sheet name. I tested the script below, but all it does is a basic split from one cell into multiple columns, which includes the sheet name, but all kinds of superfluous text, which I don't want.

Sub SplitData()
    Const SrcCol = 1 ' A
    Const TrgCol = 2 ' B
    Const FirstRow = 1
    Dim LastRow As Long
    Dim SrcRow As Long
    Dim TrgRow As Long
    Dim TheVal As String
    Dim TheArr As Variant
    Dim Num As Long
    Application.ScreenUpdating = False
    TrgRow = 1
    LastRow = Cells(Rows.Count, SrcCol).End(xlUp).Row
    For SrcRow = FirstRow To LastRow
        TheVal = Cells(SrcRow, SrcCol).Value
        TheArr = Split(TheVal, ",")
        Num = UBound(TheArr)   1
        Cells(TrgRow, TrgCol).Resize(ColumnSize:=Num).Value = TheArr
        TrgRow = TrgRow   1
    Next SrcRow
    Application.ScreenUpdating = True
End Sub

Now:

Desired:

CodePudding user response：

If you have O365, this will work for you ...

=LET(x, TRANSPOSE(FILTERXML("<d><r>" & SUBSTITUTE(A1, ",", "</r><r>") & "</r></d>", "//r[contains(text(),""!"")]")), MID(x, 1, FIND("!", x)))

... here's hoping you do, a lot easier.

Alternatively, I created my own VBA routine with the assumption that everything to the right of the formula is free to load into, just adjust for errors, names, performance, etc. as required ...

Public Sub GetWorksheets()
    Dim lngRow As Long, lngColumn As Long, strFormula As String
    Dim arrFormula() As String, i As Long, arrSubFormula() As String
    
    With Sheet1
        For lngRow = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            strFormula = Trim(.Cells(lngRow, 1))
            lngColumn = 2
            
            If strFormula <> "" Then
                arrFormula = Split(strFormula, "!")
                
                For i = 0 To UBound(arrFormula) - 1
                    arrSubFormula = Split(arrFormula(i), ",")
                    strFormula = arrSubFormula(UBound(arrSubFormula)) & "!"
                    
                    .Cells(lngRow, lngColumn) = strFormula
                    lngColumn = lngColumn   1
                Next
            End If
        Next
    End With
End Sub