I'm not sure I understand (especially how D4 or D8 changes), but maybe this
would get you closer:

Option Explicit
Sub SortMatch()

Dim wks As Worksheet
Dim TryCtr As Long
Dim MaxTries As Long
Dim SetCtr As Long
Dim MaxSets As Long

Set wks = ActiveSheet
MaxTries = 10
MaxSets = 3

Application.ScreenUpdating = False

With wks
.Columns(3).Insert
.Range("C1:C8").FormulaR1C1 = "=RAND()"

With .Range("A1:C8")
.Sort Key1:=.Columns(3), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With

SetCtr = 0
TryCtr = 0
Do
'How could the line above be amended to
'handle the scenario where the
'condition is approximate, eg: stop the
'randomization if the absolute value
'of D4 is within 5% of D8's ?

'I think that this is the formula you're describing:
'=ABS((ABS(D4)/D8)-1)<=0.05

If IsNumeric(.Range("d8").Value) = False _
Or IsNumeric(.Range("d4").Value) = False Then
'what should happen
MsgBox "non-numerics in d4 and/or d8"
Exit Do
Else
If .Range("d8").Value = 0 Then
'what should happen?
MsgBox "D8 is 0"
Exit Do
Else
If Abs((Abs(.Range("D4").Value) / .Range("D8").Value) - 1) _
<= 0.05 Then
.Columns(3).Delete
MsgBox "Found one set"
SetCtr = SetCtr + 1
.Range("A1:C8").PrintOut preview:=True
If SetCtr = MaxSets Then
Exit Do
End If
End If
End If
End If
TryCtr = TryCtr + 1
If TryCtr MaxTries Then
MsgBox "Too many tries"
Exit Do
End If
Loop
End With

Application.ScreenUpdating = True
End Sub



Max wrote:

Hi, seeking help with 2 follow-ons
to the Sub SortMatch() posted by JBeaucaire in .misc

1. If [D4] = [D8] Then
How could the line above be amended to handle the scenario where the
condition is approximate, eg: stop the randomization if the absolute value
of
D4 is within 5% of D8's ?

2. How could the sub be modified to re-generate & "print" several sets of
possible result combinations (say 3 result sets) to the right of the source
data in A1:B8 (let's assume the source data is to be left intact)

Thanks for any insights
Max

"JBeaucaire" wrote:
Similar to above, but rather than manually having to press F9 over and
over,
here's a layout and a macro to do it in one click:

Text Values A1:A8
Numbers B1:B8
Formula in C4 =SUM(B1:B4)
Formula in C8 =SUM(B5:B8)

Now, here's the macro, run it and it shuffle the data until a matching set
is created and then stop.

Sub SortMatch()
Application.ScreenUpdating = False
Columns("C:C").Insert Shift:=xlToRight
Range("C1:C8").FormulaR1C1 = "=RAND()"

Start:
Range("A1:C8").Sort Key1:=Range("C1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

If [D4] = [D8] Then
Columns("C:C").Delete Shift:=xlToLeft
MsgBox "Found one set"
Else
GoTo Start
End If

Application.ScreenUpdating = True
End Sub

--

Dave Peterson