Sub-String Extraction !

[Eddny]

Hello!

The code below works fine to generate all possible combinations of 37 numbers choosing 6 at a time.
That is, 37 combin 6 = 2,324,784 strings
However, I don't need all the 2M plus output strings. I only need the output strings that contain the numbers "3" and "5".

Of course I could generate all the 2M plus strings and loop over each, test and select the strings containing "3" and "5" but I want the original generation code itself to be modified so that I don't have to re-loop over the output to get the substrings I need.
BTW, the original code was written a while back by someone called Bruno, I believe. (I thought I would give credit to the owner).
Any help would be appreciated.

Ed
========================================

Sub CombinazioniS()


Dim i As Long, j As Long, k As Long, FactClass As Long, n As Long
Dim CS() As Long, NumComb As Long, Elements As Long, Class As Long
Dim TargetRange As Range, S As String, RowsPerColumn As Long, T As
Double


' Definition -------------------------
Elements = 37
Class = 6
Set TargetRange = [Sheet10!CK25]
RowsPerColumn = 500000 ' Printing Layout
' ------------------------------------


T = Timer
' NumComb = Numero delle combinazioni
' ------------------------------------
NumComb = 1
For i = Elements To Elements - Class + 1 Step -1
NumComb = NumComb * i
Next
FactClass = 1
For i = Class To 2 Step -1
FactClass = FactClass * i
Next
NumComb = NumComb / FactClass
' -------------------------------------
ReDim CS(1 To NumComb, 1 To Class)
For i = 1 To Class
CS(1, i) = i
Next
For i = 2 To NumComb
k = Class
Do Until CS(i - 1, k) < Elements - Class + k
k = k - 1
Loop
For j = 1 To k - 1
CS(i, j) = CS(i - 1, j)
Next
CS(i, k) = CS(i - 1, k) + 1
For j = k + 1 To Class
CS(i, j) = CS(i, j - 1) + 1
Next
Next


' Stampa in TargetRange-down
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
n = 0: k = 1
For i = 1 To UBound(CS, 1)
S = ""
For j = 1 To UBound(CS, 2)
S = S & CS(i, j) & " "
Next
'MsgBox S
n = n + 1
TargetRange(n, k) = S
If i Mod RowsPerColumn = 0 Then
k = k + 1
n = 0
End If
Next




End Sub

 

[Keebellah]

HI, welcome to the forum, please use code tags when posting code

Since you've written the code just add a test that only posts the strings if they it contains a 3 or a 5

 

[jproffer]

'code creating combi string...say it's variable "X"
    If InStr(1, X, "3") And InStr(1, X, "5") Then 'if you want 3 OR 5, then change And to Or obviously.
'code that posts that string to your worksheet

Or something like that. It would be much easier for you to modify your own code since you wrote it, but that line of code will test for what you want.

 

[Keebellah]

This only shows the stings with "3" and "5"

Sub CombinazioniS()


Dim i As Long, j As Long, k As Long, FactClass As Long, n As Long
Dim CS() As Long, NumComb As Long, Elements As Long, Class As Long
Dim TargetRange As Range, S As String, RowsPerColumn As Long, T As Double


' Definition -------------------------
Elements = 37
Class = 6
Set TargetRange = [Sheet10!CK25]
RowsPerColumn = 500000 ' Printing Layout
' ------------------------------------




T = Timer
' NumComb = Numero delle combinazioni
' ------------------------------------
NumComb = 1
For i = Elements To Elements - Class + 1 Step -1
    NumComb = NumComb * i
Next
FactClass = 1
For i = Class To 2 Step -1
    FactClass = FactClass * i
Next
NumComb = NumComb / FactClass
' -------------------------------------
ReDim CS(1 To NumComb, 1 To Class)
For i = 1 To Class
    CS(1, i) = i
Next
For i = 2 To NumComb
    k = Class
    Do Until CS(i - 1, k) < Elements - Class + k
        k = k - 1
    Loop
    For j = 1 To k - 1
    CS(i, j) = CS(i - 1, j)
    Next
    CS(i, k) = CS(i - 1, k) + 1
    For j = k + 1 To Class
        CS(i, j) = CS(i, j - 1) + 1
    Next
Next




' Stampa in TargetRange-down
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
n = 0: k = 1
For i = 1 To UBound(CS, 1)
    Application.StatusBar = "Procesando " & i & " de " & UBound(CS, 1) & Space(5) & Format(i / UBound(CS, 1), "#0.0 %")
    S = ""
    For j = 1 To UBound(CS, 2)
        S = S & CS(i, j) & " "
    Next
    If InStr(1, S, "3") = 0 And InStr(1, S, "5") = 0 Then GoTo nexti
    'MsgBox S
    n = n + 1
    TargetRange(n, k) = S
    If i Mod RowsPerColumn = 0 Then
        k = k + 1
        n = 0
    End If
nexti:
Next
Application.StatusBar = False
End Sub

 

[Eddny]

Hello, I would like to modify the code slightly so that it writes each output string into a cell as it is generated rather than wait till all the total output strings are generated before they are written into the cells. Any assistance would be appreciated.


Thanks!
Eddny

 

[Keebellah]

Well, have you tried it?

 

[mikerickson]

If you have code that will extract all 6 element combinations of strings {"1", "2", "3", "4", "5", "6", "7", ..., "37"}.
Change it to extract all 5 element combinations of {"1", "2", "4", "6", "7", "8", ... "37"}
Then put "3" into each of those strings
Then put "5" into each of those strings.

Then extract 4 element combinations of the reduced set and put both "3" and "5" in to it.

I didn't check your code to see if order mattered, but in any case, creating from the smaller set and adding the required numbers will be faster than creating from the large set and excluding.

 

[Eddny]

Well, have you tried it?

If by asking "...have you tried it," you meant "have I tried your code," the answer is yes. It worked and answered my first request of only printing out the output strings containing "3" and "5".


My second request is to modify the original code again where it prints out the output to the sheet one at a time instead of putting all 2M plus strings in arr CS() and then writing to the sheet. We can ignore the filtering requirment of "3" and "5" for this request.


The reason I want to modify the original code to print one output at a time is due to memory issues. Writing one output string to the sheet at a time may not be faster but it will be perfectly fine because I won't have to worry about memory issues.
Any help would be appreciated.

 

[ask2tsp]

this is the modified code.
In the beginning the calculation of numcomb is done with the combin function.
The cels in the worksheet only contains combinations that have a 3 and a 5.

Sub CombinazioniS()

Dim i As Long, j As Long, k As Long, FactClass As Long, n As Long
Dim CS() As Long, NumComb As Long, Elements As Long, Class As Long
Dim TargetRange As Range, S As String, RowsPerColumn As Long, T As Double


' Definition -------------------------
Elements = 37
Class = 6
Set TargetRange = [Blad1!C3]
RowsPerColumn = 50000 ' Printing Layout
' ------------------------------------


T = Timer
' NumComb = Numero delle combinazioni
' ------------------------------------
NumComb = WorksheetFunction.Combin(Elements, Class)

' -------------------------------------
ReDim CS(1 To NumComb, 1 To Class)
For i = 1 To Class
CS(1, i) = i
Next
For i = 2 To NumComb
k = Class
Do Until CS(i - 1, k) < Elements - Class + k
k = k - 1
Loop
For j = 1 To k - 1
CS(i, j) = CS(i - 1, j)
Next
CS(i, k) = CS(i - 1, k) + 1
For j = k + 1 To Class
CS(i, j) = CS(i, j - 1) + 1
Next
Next


' Stampa in TargetRange-down
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
n = 0: k = 1
Dim c3 As Boolean, c5 As Boolean
For i = 1 To UBound(CS, 1)
  S = "": c3 = False: c5 = False
  For j = 1 To UBound(CS, 2)
    If CS(i, j) = 3 Then c3 = True
    If CS(i, j) = 5 Then c5 = True
    S = S & CS(i, j) & " "
  Next j
  'MsgBox S
  If c3 And c5 Then
    n = n + 1
    TargetRange(n, k) = S
  End If
  
  If n Mod RowsPerColumn = 0 Then
    k = k + 1
    n = 0
  End If
Next i

End Sub

 

[Eddny]

If you have code that will extract all 6 element combinations of strings {"1", "2", "3", "4", "5", "6", "7", ..., "37"}.
Change it to extract all 5 element combinations of {"1", "2", "4", "6", "7", "8", ... "37"}
Then put "3" into each of those strings
Then put "5" into each of those strings.

Then extract 4 element combinations of the reduced set and put both "3" and "5" in to it.

I didn't check your code to see if order mattered, but in any case, creating from the smaller set and adding the required numbers will be faster than creating from the large set and excluding.

Thanks, for your input. The issue of printing out elements that only contain "3" and "5" has been resolved by Keebellah's code. So we can ignore that.


My second request is to modify the original code so that instead of storing all the 2M outputs into array CS() before pouring them onto the sheet, it will print them to the sheet one at a time as they are generated.


Also, my code is a code for "combinations" (that is, N choose K), and not "permutations" so order does not matter. But that is a side note and not the point here. All I want is a modification of the original code where each output prints to worksheet as it is generated rather storing all of them in an array before printing them back to sheet. Fastness or the need for the outputs to contain "3" or "5" are not requirements for this second request.