Gobbomaster
New Member
- Joined
- May 16, 2008
- Messages
- 28
Hi all,
I needed to have all permutations of a set of words. There can be 1 up to 9 words, and all permutations must be printed.
I discovered the update screen option and already put it to false (while calculating) but it's still impossible to calculate all the permutations of 9 words with my code. Up to 7 goes ok but my computer tried for 45 minutes to get the last one and then I stopped it (dual core 3.0 gh) Can someone perhaps change the following code into a recursive one because I don't know how to do it in VBA? Prods is the number of recursive words.
Please don't be scared of the size, I think it's just because it is not recursive.. There would probably be something like 10 lines left then.
I needed to have all permutations of a set of words. There can be 1 up to 9 words, and all permutations must be printed.
I discovered the update screen option and already put it to false (while calculating) but it's still impossible to calculate all the permutations of 9 words with my code. Up to 7 goes ok but my computer tried for 45 minutes to get the last one and then I stopped it (dual core 3.0 gh) Can someone perhaps change the following code into a recursive one because I don't know how to do it in VBA? Prods is the number of recursive words.
Please don't be scared of the size, I think it's just because it is not recursive.. There would probably be something like 10 lines left then.
Code:
pastehere = 12
Application.ScreenUpdating = False
Select Case prods
Case 1
For i1 = 2 To (prods + 1)
Range(Cells(i1, 1), Cells(i1, 4)).Select
Selection.Copy
pasterange1 = "A" & pastehere
Range(pasterange1).PasteSpecial Paste:=xlPasteValues
Range(pasterange1, Cells(pastehere, 4)).BorderAround (xlContinuous)
pastehere = pastehere + prods
Next
Case 2
For i1 = 2 To (prods + 1)
For i2 = 2 To (prods + 1)
If (i1 <> i2) Then
Range(Cells(i1, 1), Cells(i1, 4)).Select
Selection.Copy
pasterange1 = "A" & pastehere
Range(pasterange1).PasteSpecial Paste:=xlPasteValues
Range(Cells(i2, 1), Cells(i2, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 1)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(pasterange1, Cells((pastehere + (prods - 1)), 4)).BorderAround (xlContinuous)
pastehere = pastehere + prods
End If
Next
Next
Case 3
For i1 = 2 To (prods + 1)
For i2 = 2 To (prods + 1)
For i3 = 2 To (prods + 1)
If (i1 <> i2) And (i1 <> i3) And (i2 <> i3) Then
Range(Cells(i1, 1), Cells(i1, 4)).Select
Selection.Copy
pasterange1 = "A" & pastehere
Range(pasterange1).PasteSpecial Paste:=xlPasteValues
Range(Cells(i2, 1), Cells(i2, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 1)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i3, 1), Cells(i3, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 2)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(pasterange1, Cells((pastehere + (prods - 1)), 4)).BorderAround (xlContinuous)
pastehere = pastehere + prods
End If
Next
Next
Next
Case 4
For i1 = 2 To (prods + 1)
For i2 = 2 To (prods + 1)
For i3 = 2 To (prods + 1)
For i4 = 2 To (prods + 1)
If (i1 <> i2) And (i1 <> i3) And (i2 <> i3) And (i1 <> i4) And (i2 <> i4) And (i3 <> i4) Then
Range(Cells(i1, 1), Cells(i1, 4)).Select
Selection.Copy
pasterange1 = "A" & pastehere
Range(pasterange1).PasteSpecial Paste:=xlPasteValues
Range(Cells(i2, 1), Cells(i2, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 1)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i3, 1), Cells(i3, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 2)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i4, 1), Cells(i4, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 3)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(pasterange1, Cells((pastehere + (prods - 1)), 4)).BorderAround (xlContinuous)
pastehere = pastehere + prods
End If
Next
Next
Next
Next
Case 5
For i1 = 2 To (prods + 1)
For i2 = 2 To (prods + 1)
For i3 = 2 To (prods + 1)
For i4 = 2 To (prods + 1)
For i5 = 2 To (prods + 1)
If (i1 <> i2) And (i1 <> i3) And (i2 <> i3) And (i1 <> i4) And (i2 <> i4) And (i3 <> i4) And (i1 <> i5) And (i2 <> i5) And (i3 <> i5) And (i4 <> i5) Then
Range(Cells(i1, 1), Cells(i1, 4)).Select
Selection.Copy
pasterange1 = "A" & pastehere
Range(pasterange1).PasteSpecial Paste:=xlPasteValues
Range(Cells(i2, 1), Cells(i2, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 1)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i3, 1), Cells(i3, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 2)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i4, 1), Cells(i4, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 3)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i5, 1), Cells(i5, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 4)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(pasterange1, Cells((pastehere + (prods - 1)), 4)).BorderAround (xlContinuous)
pastehere = pastehere + prods
End If
Next
Next
Next
Next
Next
Case 5
For i1 = 2 To (prods + 1)
For i2 = 2 To (prods + 1)
For i3 = 2 To (prods + 1)
For i4 = 2 To (prods + 1)
For i5 = 2 To (prods + 1)
For i6 = 2 To (prods + 1)
If (i1 <> i2) And (i1 <> i3) And (i2 <> i3) And (i1 <> i4) And (i2 <> i4) And (i3 <> i4) And (i1 <> i5) And _
(i2 <> i5) And (i3 <> i5) And (i4 <> i5) And (i1 <> i6) And (i2 <> i6) And (i3 <> i6) And (i4 <> i6) And (i5 <> i6) Then
Range(Cells(i1, 1), Cells(i1, 4)).Select
Selection.Copy
pasterange1 = "A" & pastehere
Range(pasterange1).PasteSpecial Paste:=xlPasteValues
Range(Cells(i2, 1), Cells(i2, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 1)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i3, 1), Cells(i3, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 2)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i4, 1), Cells(i4, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 3)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i5, 1), Cells(i5, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 4)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i6, 1), Cells(i6, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 5)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(pasterange1, Cells((pastehere + (prods - 1)), 4)).BorderAround (xlContinuous)
pastehere = pastehere + prods
End If
Next
Next
Next
Next
Next
Next
Case 6
For i1 = 2 To (prods + 1)
For i2 = 2 To (prods + 1)
For i3 = 2 To (prods + 1)
For i4 = 2 To (prods + 1)
For i5 = 2 To (prods + 1)
For i6 = 2 To (prods + 1)
For i7 = 2 To (prods + 1)
If (i1 <> i2) And (i1 <> i3) And (i2 <> i3) And (i1 <> i4) And (i2 <> i4) And (i3 <> i4) And (i1 <> i5) And _
(i2 <> i5) And (i3 <> i5) And (i4 <> i5) And (i1 <> i6) And (i2 <> i6) And (i3 <> i6) And (i4 <> i6) And _
(i5 <> i6) And (i1 <> i7) And (i2 <> i7) And (i3 <> i7) And (i4 <> i7) And (i5 <> i7) And (i6 <> i7) Then
Range(Cells(i1, 1), Cells(i1, 4)).Select
Selection.Copy
pasterange1 = "A" & pastehere
Range(pasterange1).PasteSpecial Paste:=xlPasteValues
Range(Cells(i2, 1), Cells(i2, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 1)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i3, 1), Cells(i3, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 2)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i4, 1), Cells(i4, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 3)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i5, 1), Cells(i5, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 4)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i6, 1), Cells(i6, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 5)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i7, 1), Cells(i7, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 6)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(pasterange1, Cells((pastehere + (prods - 1)), 4)).BorderAround (xlContinuous)
pastehere = pastehere + prods
End If
Next
Next
Next
Next
Next
Next
Next
Case 7
For i1 = 2 To (prods + 1)
For i2 = 2 To (prods + 1)
For i3 = 2 To (prods + 1)
For i4 = 2 To (prods + 1)
For i5 = 2 To (prods + 1)
For i6 = 2 To (prods + 1)
For i7 = 2 To (prods + 1)
For i8 = 2 To (prods + 1)
If (i1 <> i2) And (i1 <> i3) And (i2 <> i3) And (i1 <> i4) And (i2 <> i4) And (i3 <> i4) And (i1 <> i5) And _
(i2 <> i5) And (i3 <> i5) And (i4 <> i5) And (i1 <> i6) And (i2 <> i6) And (i3 <> i6) And (i4 <> i6) And _
(i5 <> i6) And (i1 <> i7) And (i2 <> i7) And (i3 <> i7) And (i4 <> i7) And (i5 <> i7) And (i6 <> i7) And _
(i1 <> i8) And (i2 <> i8) And (i3 <> i8) And (i4 <> i8) And (i5 <> i8) And (i6 <> i8) And (i7 <> i8) Then
Range(Cells(i1, 1), Cells(i1, 4)).Select
Selection.Copy
pasterange1 = "A" & pastehere
Range(pasterange1).PasteSpecial Paste:=xlPasteValues
Range(Cells(i2, 1), Cells(i2, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 1)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i3, 1), Cells(i3, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 2)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i4, 1), Cells(i4, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 3)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i5, 1), Cells(i5, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 4)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i6, 1), Cells(i6, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 5)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i7, 1), Cells(i7, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 6)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i8, 1), Cells(i8, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 7)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(pasterange1, Cells((pastehere + (prods - 1)), 4)).BorderAround (xlContinuous)
pastehere = pastehere + prods
End If
Next
Next
Next
Next
Next
Next
Next
Next
Case 8
For i1 = 2 To (prods + 1)
For i2 = 2 To (prods + 1)
For i3 = 2 To (prods + 1)
For i4 = 2 To (prods + 1)
For i5 = 2 To (prods + 1)
For i6 = 2 To (prods + 1)
For i7 = 2 To (prods + 1)
For i8 = 2 To (prods + 1)
For i9 = 2 To (prods + 1)
If (i1 <> i2) And (i1 <> i3) And (i2 <> i3) And (i1 <> i4) And (i2 <> i4) And (i3 <> i4) And (i1 <> i5) And _
(i2 <> i5) And (i3 <> i5) And (i4 <> i5) And (i1 <> i6) And (i2 <> i6) And (i3 <> i6) And (i4 <> i6) And _
(i5 <> i6) And (i1 <> i7) And (i2 <> i7) And (i3 <> i7) And (i4 <> i7) And (i5 <> i7) And (i6 <> i7) And _
(i1 <> i8) And (i2 <> i8) And (i3 <> i8) And (i4 <> i8) And (i5 <> i8) And (i6 <> i8) And (i7 <> i8) And _
(i1 <> i9) And (i2 <> i9) And (i3 <> i9) And (i4 <> i9) And (i5 <> i9) And (i6 <> i9) And (i7 <> i9) And _
(i8 <> i9) Then
Range(Cells(i1, 1), Cells(i1, 4)).Select
Selection.Copy
pasterange1 = "A" & pastehere
Range(pasterange1).PasteSpecial Paste:=xlPasteValues
Range(Cells(i2, 1), Cells(i2, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 1)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i3, 1), Cells(i3, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 2)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i4, 1), Cells(i4, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 3)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i5, 1), Cells(i5, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 4)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i6, 1), Cells(i6, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 5)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i7, 1), Cells(i7, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 6)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i8, 1), Cells(i8, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 7)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i9, 1), Cells(i9, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 8)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(pasterange1, Cells((pastehere + (prods - 1)), 4)).BorderAround (xlContinuous)
pastehere = pastehere + prods
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Case 9
For i1 = 2 To (prods + 1)
For i2 = 2 To (prods + 1)
For i3 = 2 To (prods + 1)
For i4 = 2 To (prods + 1)
For i5 = 2 To (prods + 1)
For i6 = 2 To (prods + 1)
For i7 = 2 To (prods + 1)
For i8 = 2 To (prods + 1)
For i9 = 2 To (prods + 1)
For i10 = 2 To (prods + 1)
If (i1 <> i2) And (i1 <> i3) And (i2 <> i3) And (i1 <> i4) And (i2 <> i4) And (i3 <> i4) And (i1 <> i5) And _
(i2 <> i5) And (i3 <> i5) And (i4 <> i5) And (i1 <> i6) And (i2 <> i6) And (i3 <> i6) And (i4 <> i6) And _
(i5 <> i6) And (i1 <> i7) And (i2 <> i7) And (i3 <> i7) And (i4 <> i7) And (i5 <> i7) And (i6 <> i7) And _
(i1 <> i8) And (i2 <> i8) And (i3 <> i8) And (i4 <> i8) And (i5 <> i8) And (i6 <> i8) And (i7 <> i8) And _
(i1 <> i9) And (i2 <> i9) And (i3 <> i9) And (i4 <> i9) And (i5 <> i9) And (i6 <> i9) And (i7 <> i9) And _
(i8 <> i9) And (i1 <> i10) And (i2 <> i10) And (i3 <> i10) And (i4 <> i10) And (i5 <> i10) And (i6 <> i10) And _
(i7 <> i10) And (i8 <> i10) And (i9 <> i10) Then
Range(Cells(i1, 1), Cells(i1, 4)).Select
Selection.Copy
pasterange1 = "A" & pastehere
Range(pasterange1).PasteSpecial Paste:=xlPasteValues
Range(Cells(i2, 1), Cells(i2, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 1)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i3, 1), Cells(i3, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 2)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i4, 1), Cells(i4, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 3)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i5, 1), Cells(i5, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 4)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i6, 1), Cells(i6, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 5)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i7, 1), Cells(i7, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 6)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i8, 1), Cells(i8, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 7)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i9, 1), Cells(i9, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 8)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(Cells(i10, 1), Cells(i10, 4)).Select
Selection.Copy
pasterange = "A" & (pastehere + 9)
Range(pasterange).PasteSpecial Paste:=xlPasteValues
Range(pasterange1, Cells((pastehere + (prods - 1)), 4)).BorderAround (xlContinuous)
pastehere = pastehere + prods
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
End Select
Application.ScreenUpdating = True