ma1ah
ma1ah

Reputation: 1

write a specific split function with vba

I am writing a vba code to split some texts base on a delimiter and then write each word in a cell. but the code is only able to split numbers and not the text. I don't know what is wrong. please help me

Function mysplit(strText As String, delimiter As String)
    Dim i As Integer
    Dim nchoose As Integer
    Dim str1 As String
    Dim str2 As String
    Dim delimiterposition As Integer
    Dim r1 As Range
    
    Set r1 = Application.Caller
    delimiterposition = InStr(strText, delimiter)
    i = 1
    nchoose = 1
    Do Until delimiterposition = 0
        str1 = Left(strText, delimiterposition - 1)
        strText = Right(strText, Len(strText) - delimiterposition)
        delimiterposition = InStr(strText, delimiter)
        Evaluate "other_cell_writer(" & r1.Offset(0, i).Address(False, False) & "," & str1 & "," & nchoose & ")"
        i = i + 1
        nchoose = -1 * nchoose
        Loop
        Evaluate "other_cell_writer(" & r1.Offset(0, i).Address(False, False) & "," & strText & "," & nchoose & ")"
        mysplit = "ok"
End Function

Sub other_cell_writer(ResultCell As Range, str1 As String, nchoose As Integer)
    ResultCell.Offset(1, 0).Formula = str1
    ResultCell.Value = str1
    If nchoose = 1 Then
        ResultCell.Interior.ThemeColor = xlThemeColorAccent2
        ResultCell.Offset(1, 0).Interior.ThemeColor = xlThemeColorAccent2
        ResultCell.Offset(1, 0).Interior.TintAndShade = 0.799981688894314
    ElseIf nchoose = -1 Then
        ResultCell.Interior.ThemeColor = xlThemeColorAccent5
        ResultCell.Offset(1, 0).Interior.ThemeColor = xlThemeColorAccent5
        ResultCell.Offset(1, 0).Interior.TintAndShade = 0.799981688894314
    End If
End Sub

Upvotes: 0

Views: 84

Answers (1)

Tim Williams
Tim Williams

Reputation: 166331

You're not quoting the arguments correctly in the call to Evaluate

This worked for me:

Function mysplit(strText As String, delimiter As String)
    Dim c As Range
    Set c = Application.ThisCell
    c.Parent.Evaluate "other_cell_writer(" & c.Address() & ",""" & strText & """,""" & delimiter & """)"
    mysplit = "ok"
End Function

Function other_cell_writer(FormulaCell As Range, str1 As String, delim As String)
    
    Dim arr, v, i, n
    
    arr = Split(str1, delim)
    For i = LBound(arr) To UBound(arr)
        With FormulaCell.Offset(0, n + 1)
            .Value = arr(i)
            .Interior.Color = IIf(i Mod 2 = 0, vbRed, vbYellow)
        End With
        n = n + 1
    Next i
    
End Function

Note you really want the Worksheet.Evaluate method and not the default (implicit) Application.Evaluate, which will use the active sheet as the context for evaluating the call.

If strText might contain double-quotes you will need to escape those before concatenating it into the call to Evaluate.

Upvotes: 2

Related Questions