How to get combinations and derive formulas?

Hi grantor,

Have a look on the attachment with simple (but probably effective enough for this purpose macro).

Sub prepare()
Dim outrow As Long, t As Double
  outrow = 10
  t = Timer
  Application.ScreenUpdating = False
  Call combine("ABCDEFGHIJKLMNOPQRS", "", outrow)
  Range("H10:I10").AutoFill Destination:=Range("H10:I978")
  MsgBox "Finshed in " & Format(Timer - t, "#.0") & " s"
End Sub

Sub combine(source As String, ready As String, outrow As Long)
Dim i As Byte
If Len(ready) = 3 Then
  Cells(outrow, 1) = ready
  For i = 1 To 3
    Cells(outrow, i + 1) = Cells(1, Mid(ready, i, 1))
    Cells(outrow, i + 4) = Cells(2, Mid(ready, i, 1))
  Next i
  outrow = outrow + 1
Else
  For i = 1 To Len(source)
    If Len(source) - i + Len(ready) + 1 >= 3 Then _
      Call combine(Mid(source, i + 1), ready & Mid(source, i, 1), outrow)
  Next i
End If
End Sub

I followed your described input data layout. the output is 969 rows with linest for all combination of triplets of your data.
I skipped in the macro the part about random sheets because I do not think I understood it well.
Of course you can comment or delete out rows:

  For i = 1 To 3
    Cells(outrow, i + 1) = Cells(1, Mid(ready, i, 1))
    Cells(outrow, i + 4) = Cells(2, Mid(ready, i, 1))
  Next i

and use for instance INDIRECT function with RAND as input For instance see B10:

Formula:

=INDIRECT("Arkusz"&ROUNDUP(RAND()*3,0)&"!"&MID($A10,COLUMN(A1),1)&2)

and next cells in attachment (before running unmodified macro). And after macro - copy such INDIRECT formulas down. - you will introduce some stochastics into data picking process.

Just for the future

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

Hi,
I'm pretty sure I published answer yesterday morning. But can't see it now (the same happened in another thread: http://www.excelforum.com/excel-prog...ml#post3937239 ). Fortunately also your file was still in my trash. So try (again, it is not very quick - takes few seconds - but simple and easy to understand algorithm):

Sub fill_in()
Dim i As Long, j As Integer, c As Integer, calcmode As Integer, lr As Long, combin
Application.ScreenUpdating = False
calcmode = Application.Calculation
Application.Calculation = xlCalculationManual
Sheets("combinations").Activate
For i = 5 To 973
  combin = Split(Cells(i, "A"), ",")
  For j = 0 To 2
    c = 2 * (Asc(combin(j)) - Asc("a") + 1)
    With Sheets("LHC values")
      lr = .Cells(.Rows.Count, c).End(xlUp).Row 'data in LHC is randomized so pick bottom-up
      .Cells(lr, c).Cut Cells(i, j + 2)
      .Cells(lr, c + 1).Cut Cells(i, j + 5)
    End With
  Next j
Next i
Application.Calculation = calcmode
End Sub

PS. The number of rows you have to prepare in LH are "trianglular numbers" http://en.wikipedia.org/wiki/Triangular_number
so for 3 dates just 1 LHC row, for 4-> 3, 9 -> indeed 28, 19-> 153, 26 -> 300 etc.

and to prepare combinations sets (as used in sheet combinations) a bit modified piece of code from some posts above (run in empty sheet):

Sub prepare()
Dim outrow As Long, outcolumn As Long, t As Double
t = Timer
Application.ScreenUpdating = False
For outcolumn = 1 To 24
  outrow = 1
  Call combine(Left("abcdefghijklmnopqrstuvwxyz", outcolumn + 2), "", outrow, outcolumn)
Next outcolumn
MsgBox "Finshed in " & Format(Timer - t, "#.0") & " s"
End Sub

Sub combine(source As String, ready As String, outrow As Long, outcolumn)
Dim i As Byte
If Len(ready) = 3 Then
  Cells(outrow, outcolumn) = Left(ready, 1) & "," & Mid(ready, 2, 1) & "," & Right(ready, 1)
  outrow = outrow + 1
Else
  For i = 1 To Len(source)
    If Len(source) - i + Len(ready) + 1 >= 3 Then _
      Call combine(Mid(source, i + 1), ready & Mid(source, i, 1), outrow, outcolumn)
  Next i
End If
End Sub

As the values are random, I thought, it does not matter what sequence they are picked.
OK, Bottom-up is not-so-good, so what would be better - top-down:

Sub fill_in_top_down()
Dim i As Long, j As Integer, c As Integer, calcmode As Integer, combin
Application.ScreenUpdating = False
calcmode = Application.Calculation
Application.Calculation = xlCalculationManual
Sheets("combinations").Activate
For i = 5 To 973
  combin = Split(Cells(i, "A"), ",")
  For j = 0 To 2
    c = 2 * (Asc(combin(j)) - Asc("a") + 1)
    With Sheets("LHC values")
      .Cells(8, c).Cut Cells(i, j + 2)
      .Cells(8, c + 1).Cut Cells(i, j + 5)
      .Cells(8, c).resize(1,2).delete shift:=xlup
    End With
  Next j
Next i
Application.Calculation = calcmode
End Sub

of random row:

Sub fill_in_random()
Dim i As Long, j As Integer, c As Integer, calcmode As Integer, k As Long, lr As Long, combin
Application.ScreenUpdating = False
calcmode = Application.Calculation
Application.Calculation = xlCalculationManual
Sheets("combinations").Activate
For i = 5 To 973
  combin = Split(Cells(i, "A"), ",")
  For j = 0 To 2
    c = 2 * (Asc(combin(j)) - Asc("a") + 1)
    With Sheets("LHC values")
      lr = .Cells(.Rows.Count, c).End(xlUp).Row
      k = Application.WorksheetFunction.RandBetween(8, lr)
      .Cells(k, c).Cut Cells(i, j + 2)
      .Cells(k, c + 1).Cut Cells(i, j + 5)
      .Cells(k, c).Resize(1, 2).Delete shift:=xlUp
    End With
  Next j
Next i
Application.Calculation = calcmode
End Sub

as for other numbers of combinations:
5 (start row) To 973 (lastrow) is the scope for main loop - adjust it and make sure you provided enough data in LHC sheet.

Hi ocnerol,

Unfortunately your post does not comply with Rule 2 of our Forum RULES. Do not post a question in the thread of another member -- start your own thread.

If you feel an existing thread is particularly relevant to your need, provide a link to the other thread in your new thread.

Old threads are often only monitored by the original participants. New threads not only open you up to all possible participants again, they typically get faster response, too.

So please do as advised above - post new thread and give a link to this one.