Permutations andText to column problem

  • Thread starter Thread starter Howard
  • Start date Start date
H

Howard

I enter 123 in A1 and run DoString which produces all combinations in Column A.

The Text to Columns part does 1 cell (A1) in D1, E1, F1 and then asks if I want to replace contents of destination cells for each of the remaining Permutations.

All destination cells are blank.

What gives here?

If I manually select those permutations and run TxToCoL sub it works. And I notice 100 cell are selected as a result of the code in TxToCol.

Thanks,
Howard

Option Explicit
Option Compare Text
Dim CurrentRow

Sub DoString()

On Error Resume Next
Dim Instring As String
Dim i As Integer, j As Integer
Instring = Range("A1").Value
Range("A1").Select
CurrentRow = 1
Call GetPermutation("", Instring)

End Sub

Sub GetPermutation(X As String, y As String)
On Error Resume Next
Dim j, i
j = Len(y)
If j < 2 Then
Cells(CurrentRow, 1) = X & y
CurrentRow = CurrentRow + 1
Else
For i = 1 To j
Call GetPermutation(X + Mid(y, i, 1), _
Left(y, i - 1) + Right(y, j - i))
Next
End If
TxToCoL
End Sub

Sub TxToCoL()
On Error Resume Next
'Application.EnableEvents = False
'Application.AlertBeforeOverwriting = False
Range("A1:A100").Select
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array _
(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:= _
True
'Application.AlertBeforeOverwriting = True
'Application.EnableEvents = True
End Sub
 
Your TxToCol procedure writes all arrays to D1, hence the need to
replace previous text written there.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
I revised your code to only execute TxToCol once after all permutations
have been made. The way you had it working, it was overwriting all
existing data in D:F for each permutation...

Option Explicit
Option Compare Text

Dim lCurRow&

Sub DoString()
lCurRow = 1: Call GetPermutation("", Cells(1, 1))
Call TxToCoL
End Sub

Sub GetPermutation(X As String, y As String)
Dim j&, i&
j = Len(y)
If j < 2 Then
Cells(lCurRow, 1) = X & y: lCurRow = lCurRow + 1
Else
For i = 1 To j
GetPermutation _
X + Mid(y, i, 1), Left(y, i - 1) + Right(y, j - i))
Next 'j
End If 'j < 2
End Sub

Sub TxToCoL()
Range(Cells(1, 1), Cells(1, 1).End(xlDown)).TextToColumns _
Destination:=Range("D1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), _
Array(8, 1), Array(9, 1)), _
TrailingMinusNumbers:=True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
I revised GetPermutation further to fix a trailing closing bracket in
the loop, AND to make the code a bit less cryptic so it's easier to
follow...

Sub GetPermutation(sBlank$, sTextIn$)
Dim lTxtLen&, i&
lTxtLen = Len(sTextIn)
If lTxtLen < 2 Then
Cells(lCurRow, 1) = sBlank & y: lCurRow = lCurRow + 1
Else
For i = 1 To lTxtLen
GetPermutation sBlank + Mid(sTextIn, i, 1), _
Left(sTextIn, i - 1) + Right(sTextIn, lTxtLen - i)
Next
End If
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Oops.., I missed renaming a variable...
Sub GetPermutation(sBlank$, sTextIn$)
Dim lTxtLen&, i&
lTxtLen = Len(sTextIn)
If lTxtLen < 2 Then
Click to expand...
Cells(lCurRow, 1) = sBlank & sTextIn: lCurRow = lCurRow + 1
Else
For i = 1 To lTxtLen
GetPermutation sBlank + Mid(sTextIn, i, 1), _
Left(sTextIn, i - 1) + Right(sTextIn, lTxtLen - i)
Next
End If
End Sub
Click to expand...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
<I revised your code to only execute TxToCol once after all permutations
have been made. The way you had it working, it was overwriting all
existing data in D:F for each permutation... >

Okay, I see the error of my ways now. Correct me if I am wrong here:

As Excel promises, when you call a procedure (Sub) it will execute that procedure and then return to the next line under that Call, if there is nothing there then work is done.

I failed to see that DoString was calling GetPermutations and once GetPerm's was done it would go back to DoString for next call past Get Perm's, if any, or be done.

TxToCol is now that next call following Get Perm's. 'Splains why TxToCol works fine if ran all by itself after DoString and Get Perm's do their stuff and are out of the picture.

Thanks Garry.
Howard

P.S. A slight re-write of that 1980's archived perm code was probably due. That's when I found it with a note by a MVP stating that the author is generally acknowledged to be unknown.
 
Okay, I see the error of my ways now. Correct me if I am wrong here:
As Excel promises, when you call a procedure (Sub) it will execute
that procedure and then return to the next line under that Call, if
there is nothing there then work is done.
Click to expand...

Basically correct. Whether to use the keyword "Call" depends on your
coding. As you can see, I found it not necessary here.
I failed to see that DoString was calling GetPermutations and once
GetPerm's was done it would go back to DoString for next call past
Get Perm's, if any, or be done.
Click to expand...

Whenever you call an external procedure, execution always returns to
the caller.
TxToCol is now that next call following Get Perm's. 'Splains why
TxToCol works fine if ran all by itself after DoString and Get Perm's
do their stuff and are out of the picture.
Click to expand...

The logic to apply here is...
Get (all) Perms, then put (all) perms as TxToCols.
Thanks Garry.
Howard

P.S. A slight re-write of that 1980's archived perm code was probably
due. That's when I found it with a note by a MVP stating that the
author is generally acknowledged to be unknown.
Click to expand...

I've actually seen this sample before, but never used it and so I
didn't do my usual rewrite until now. Hopefully it's easier to follow
what it does when stepping through!<g>

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Back
Top