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
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