Break phrases into single words and then stack everything into one single column

Question

I have a report where I need to break a specific range of phrases into single words and stack them removing all duplicates.

It would be a three step process that I'm trying to automate:

Break words between spaces
Stack everything into a single column on a new sheet
Remove duplicates

I'm not a programmer myself, so trying to turn manual operation into automate operation I would:

Step 1: use "texto to column" to break the phrases

Step 2 (stack columns): no idea, I'm lost here

Step 3: use "remove duplicates" to well, remove duplicated data

I can handle the VBA for step 1 and 3, but I have no idea how to make the code automation for step 2. Any ideas how can I accomplish that?

You've got the idea! Turn on the macro recorder to record the code, and post back here. 1) Text to Columns 2) Copy each row, and paste special Transpose (this will paste "A B C" down three rows, instead of across three columns), 3) Remove Duplicates. Then stop the recorder. You'll have a very specific code, so try and [remove the use of `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). From there, if you get stuck, post the code you have and we can help. — BruceWayne, Mar 09 '17 at 22:20
Hey @BruceWayne, thanks for the answer. I've updated my question. I can handle the macro record for steps 1 and 3 by recording the macro and making subtle changes inside VBA editor, but it's at step 2 that the thing gets fuzzy. The number of columns from the breaked words will depend on how many words exists on the phrases. How can I make that automation not to rely on a specific number os columns? Any thoughts? — SoMeGoD, Mar 09 '17 at 22:37
Yeah, for sure. You'll want to look into [create a dynamic range](https://www.thespreadsheetguru.com/blog/5-ways-to-create-a-dynamic-auto-adjusting-vba-range). Essentially, when you get the text to columns done, you'll have (let's say) row 1, 3 columns. Row 2, 6 columns. Row 3, 5 columns. You just want to loop through each row, grab "column 1 to x" data, copy/paste Special transpose in to your destination column. It may be a little daunting if you're new to VBA, but if you can get some code going, I'll be happy to help work out any questions/problems you come to. — BruceWayne, Mar 09 '17 at 23:06

Bad_Neighbor · Answer 1 · 2017-03-09T23:19:24.683

To answer question 2, use a nested loop:

i = 1 j = 1 counter = 1 Do Do If ActiveSheet.Cells(i, j) = "" Then j = 1 Exit Do End If ActiveSheet.Cells(counter, 15) = ActiveSheet.Cells(i, j) counter = counter + 1 j = j + 1 Loop i = i + 1 If ActiveSheet.Cells(i, j) = "" Then Exit Do Loop

This assumes the destination field you wish to perform "remove duplicates" on is column O. This also assumes that you properly TRIM your text to columns results (seems that your values are all separated by one space anyway). Also, I don't know the name of your sheets so replace ActiveSheet with Sheets(destination_sheet) as needed.

score 0 · Answer 2 · answered Mar 09 '17 at 23:33

You can get the text from the clipboard and replace the spaces with new lines (not tested):

[A:A].Copy
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' this is late bound MSForms.DataObject
    .GetFromClipboard
    Application.CutCopyMode = False
    .SetText Replace(.GetText, " ", vbCrLf)
    .PutInClipboard
End With
[G1].PasteSpecial 
[G:G].RemoveDuplicates 1

score 0 · Answer 3 · answered Mar 09 '17 at 23:38

Here's a macro that should do it for you. I still suggest trying to get here on your own, but at the very least, you can step through this with F8 to see how it works, line by line:

Sub transposeUnique()
Dim mainWS As Worksheet, newWS As Worksheet
Dim groupRng As Range, rng As Range, cel As Range

Set mainWS = Sheets("Sheet1")    ' Change the name as required
Set newWS = Sheets("Sheet2")
With mainWS
    Set groupRng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    groupRng.Select
    newWS.Range("A2:A" & groupRng.Rows.Count + 1).Value = groupRng.Value
    Set groupRng = newWS.Range(newWS.Cells(2, 1), newWS.Cells(newWS.Cells(newWS.Rows.Count, 1).End(xlUp).Row, 1))
    groupRng.TextToColumns Destination:=newWS.Range("H2"), DataType:=xlDelimited, _
                           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True
End With

Dim numRows As Long

With newWS
    numRows = .Cells(.Rows.Count, 8).End(xlUp).Row    ' assuming you pasted the Text to Column to col. H

    Dim lastCol As Long, nextRow As Long
    nextRow = 2
    For i = 2 To numRows
        lastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(i, 8), .Cells(i, lastCol))
        rng.Copy
        .Range("G" & nextRow).PasteSpecial Transpose:=True
        nextRow = .Cells(.Rows.Count, 7).End(xlUp).Row + 1
    Next i

    .Range("G:G").RemoveDuplicates Columns:=1, Header:=xlNo
End With                     'newWS

End Sub

Break phrases into single words and then stack everything into one single column

3 Answers3