How can I take a list of values, perform multiple "cleaning" operations on them and place them elsewhere in the workbook?

Question

I just spent most of the day trying to figure out how to do this, and the most I've gotten is one or two of the operations I wanted done, and then I can't get the rest to work.

I will preface by saying that I currently have an "Intermediate" worksheet for multi-step processes, so having to do what I want that way is perfectly acceptable.

Now for that actual problem:

• I have a very large list (approaching 2000 lines) of raw data. Each cell in this list can contain either nothing (blank), 0, or either a 6 digit number (243300, 143356, etc.) or multiple 6 digit numbers in the same cell, separated by a space.

What I want to do is:

1. Remove all blank cells
2. Separate, if applicable, cells that contain more than one value
3. Remove the duplicate values
4. Sort the remaining values alpha-numerically
5. Place the resulting list in the "Main" worksheet, for a clean presentation to the users.

The solution cannot modify the values in the raw list (that's why I have the "Intermediate" worksheet) It also needs to be done automatically, so no Macros.

---

What I currently have is either:

    =IFERROR(INDEX(Raw!$G$2:$G$5000, MATCH(0, COUNTIF(Intermediate!$F$2:$F2, Raw!$G$2:$G$5000), 0)),"")

which gives me a list without blanks, no duplicates, but not sorted, and without the multi-value cells split; or

    Public Function Blah(ParamArray args()) As String
'Declarations
Dim uniqueParts As Collection
Dim area As Range
Dim arg, arr, ele, part
Dim i As Long

'Initialisations
Set uniqueParts = New Collection

'Enumerate through the arguments passed to this function
For Each arg In args
    If TypeOf arg Is Range Then 'range so we need to enumerate its .Areas
        For Each area In arg.Areas
        arr = area.Value 'for large ranges it is greatly quicker to load the data at once rather than enumerating each cell in turn
            For Each ele In arr 'enumerate the array
                 addParts CStr(ele), uniqueParts 'Call our sub to parse the data
            Next ele
        Next area
    ElseIf VarType(arg) > vbArray Then 'an array has been passed in
        For Each ele In arg 'enumerate the array
            addParts CStr(ele), uniqueParts 'Call our sub to parse the data
        Next ele
    Else 'assume can be validly converted to a string. If it cannot then it will fail fast (as intended)
        addParts CStr(arg), uniqueParts 'Call our sub to parse the data
    End If
Next arg

'process our results
If uniqueParts.Count > 0 Then
    ReDim arr(0 To uniqueParts.Count - 1)
    For i = 1 To uniqueParts.Count
        arr(i - 1) = uniqueParts(i)
    Next i
    'we now have an array of the unique parts, which we glue together using the Join function, and then return it
    Blah = Join(arr, ",")
End If

End Function
'Sub to parse the data. In this case the sub splits the string and adds the split elements to a collection, ignoring duplicates
Private Sub addParts(partsString As String, ByRef outputC As Collection)
'ByRef is unecessary but I use it to document that outputC must be instantiated
    Dim part
    For Each part In Split(partsString, ",")
        On Error Resume Next 'existing same key will raise an error, so we skip it and just carry on
        outputC.Add part, part
        On Error GoTo 0
    Next part
End Sub

which I was given a few years ago for a different need. This UDF splits multi-value cells, gets rid of blanks and duplicates, but concatenates the result afterwards.

I'm unfortunately a noob when it comes to UDF and VBA, so I can't even figure out how to change that UDF so it exports to a series of rows instead of merging the results. (I know it's the "Join" part at the end, but I don't know what to replace it with)

I'm aware that this is a tall order, but any help or nudges in the right direction are greatly welcome.

Feel free to ask if I forgot to include helpful information.

Thank you very much.

Answer 1

Here is the solution in vba :)

Sub PerformTask()
    Dim oSel As Range
    Dim oWS As Worksheet
    Dim iCol As Integer
    Dim iMax As Integer

    iMax = 10

    'Copy original sheet
    Set oWS = ActiveWorkbook.Sheets(1)
    oWS.Copy after:=oWS

    ' get the new worksheet
    Set oWS = ActiveWorkbook.Sheets(oWS.Index + 1)

    'sort column to remove blanks
    SortColumn oWS, 1

    Set oSel = oWS.Columns(1)
    oSel.TextToColumns DataType:=xlDelimited, Space:=True 'parse data

    ' sort columns assuming not more than 10 if more change iMax
    For iCol = 2 To iMax
        SortColumn oWS, iCol 'Sort column to remove blanks
    Next

    'copy data to column 1
    For iCol = 2 To iMax
        Set oSel = oWS.Cells(1, iCol)

        ' if more than one row select all
        If oSel.Offset(1, 0).Value <> "" Then
            Set oSel = Range(oSel, oSel.End(xlDown))
        End If

        oSel.Cut

        ' Move to the last free cell on column 1
        oWS.Cells(1, 1).End(xlDown).Offset(1, 0).Select
        oWS.Paste
    Next

    SortColumn oWS, 1 'Sort

End Sub

Sub SortColumn(poWS As Worksheet, piCol As Integer)
    Dim oSel As Range

    Set oSel = poWS.Columns(piCol)
    With poWS.Sort
        .SortFields.Clear
        .SortFields.Add oSel
        .SetRange oSel
        .Apply
    End With

End Sub