How to rearrange/create variations of text?

[excelrookie1]

Hi there,

I need to create variations of text in Excel.

For e.g. in cell A1 I have the text: 'squeezy clear honey'. And I need to create variations of this text in column B.

I can create this manually by typing out all the variations.

For example:

squeezy honey clear
clear squeezy honey
clear honey squeezy
honey clear squeezy
honey squeezy clear

Is there a way to automatize this process instead of manually typing out the variations?

This will save me 10+ hours.

Many thanks

[gsnidow]

This will give you an idea of where to start, and I'm not saying this is the best solution, but it will do to get you thinking. You can split your string into parts, then put them into an array. You can then do what in SQL we would call a cartesian join, or, a full join with no where clause. Here I am simply showing you how to "join" the array to itself, and the only logic I'm putting in here is to make sure we are not putting in any words twice. For any three words, we should have 6 unique combinations. An therein lies your problem. If you have a worksheet with your phrases in column "A", with no blank rows between them, then you are going to have issues trying to write the results in column "B", since every row in "A" would create 6 rows in "B". Unless, that is, you are going to write the results horizontally. That would be okay too, but if you have phrases with variable numbers of words, the whole thing will get more complex. Anyhow, this should get you started, and it assumes the example phrase you provided is populated in cell "A1".

Greg

Sub FullJoin()
    Dim arParts() As String
    Dim strOriginal As String
    
    strOriginal = ActiveSheet.Cells(1, 1)
    arParts() = Split(strOriginal, " ")
    
    For a = 0 To UBound(arParts()) - 1 Step 1
        For b = 0 To UBound(arParts()) - 1 Step 1
            For c = 0 To UBound(arParts()) - 1 Step 1
                If arParts(a) <> arParts(b) And _
                   arParts(a) <> arParts(c) And _
                   arParts(b) <> arParts(c) Then
                    MsgBox arParts(a) & " " & arParts(b) & " " & arParts(c)
                End If
            Next c
        Next b
    Next a
End Sub