How to get a string in every cell split and entered into the worksheet using VBA?-CodePudding

I have got a dataset with Excel column with skils and some of the Cells have more than one skills. I want to split the cells with multiple skills into each one per cell and then only keep the unique values. This is How I am currently trying to do it:

I want to have the ability to input the range as well as the separator as I am trying to generalise the solution

    Dim Separator As String
    Dim Rng As Range
    Dim myCell As Range
    Dim SplitArr() As String
    Dim NumofElements As Integer
    Dim MyArray() As String
    Dim X As Integer
    Dim i As Integer
    
    'Get the Separator and the Named Range
    Separator = InputBox("Enter the Separator Here: ")
    Rng = InputBox("Enter Range Here: ")
    
    'Split the String and add it to an array
    X = 0
    ReDim Preserve MyArray(X)
    For Each myCell In Rng
        If myCell <> "" Then
            SplitArr = Split(myCell.Value, Separator)
            NumofElements = UBound(SplitArr)   1
            X = X   NumofElements
            ReDim Preserve MyArray(0 To X)
            For i = 0 To NumofElements
                MyArray(X   i) = SplitArr(i)
            Next i
            Erase SplitArr
        End If
    Next
    
    'Paste the array to worksheeet
    Range(Rng).Offset(0, 1) = WorksheetFunction.Transpose(MyArray)
End Sub

I get an error in line 12, when I try to assign a name defined range to Rng. The error is

Object variable or with block variable not set

which is what I am confused with since I have declared all variables.

Here's a working example for column cells containing the following:

Business Analysis; Data Analysis; Networking; Communication Skills;
Presentation Skills; Data Analysis; Problem Solving;
Problem Solving;
Problem Solving; Business Analysis; Communication Skills;

The Expected Output should be:

Business Analysis;
Data Analysis;
Networking;
Communication Skills;
Presentation Skills;
Data Analysis;
Problem Solving
Problem Solving;
Problem Solving;
Business Analysis;
Communication Skills;

Then I can just filter them for unique values.

CodePudding user response：

Here is something I came up with to condense your code a bit:

Sub GetUnique()

Dim sep As String, arr() As String
Dim rng As Range
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

sep = Application.InputBox("Enter the Separator Here: ", Type:=2)
Set rng = Application.InputBox("Enter Range Here: ", Type:=8)
arr = Split(Join(Application.Transpose(rng), sep), sep)

For Each el In arr
    If el <> "" Then
        dict(Trim(el)) = 1
    End If
Next

rng.Offset(0, 1).Resize(dict.Count).Value = Application.Transpose(dict.Keys)

End Sub