See if this code does (more or less) what you want. I entered the 25 sets as
3-digit numbers on a sheet in column A starting in row 1 (they are loaded into
an array of a user-defined structure, and it should be pretty easy to modify
reading a different layout into the array). Since I don't know exactly what your
test is doing, I put the test in a separate function (EvaluateSets), just
looking for the first two 3-digit numbers that add to a target sum (change the
function call to the real test you want. Return True or False).
Option Explicit
'Global variables for Hawk's problem
Public Type SetInfo
SetNbr As Integer 'Set number (assigned sequentially by macro)
Val1 As Integer 'First value in set
Val2 As Integer 'Second value in set
Val3 As Integer 'Third value in set
Addr As String 'Address of cell
End Type
Public Cellz() As SetInfo, SetCnt As Integer
Public SolnSet1 As Integer, SolnSet2 As Integer
Sub FindSoln()
Dim x As Integer, aa As Integer
'Assuming data starts in A1 on the active sheet. Sets values are concatenated
into 3-digit numbers.
ActiveSheet.Range("A1").Activate
x% = 1
SetCnt% = -1
Do While Len(ActiveCell.Value) > 0
SetCnt% = SetCnt% + 1
ReDim Preserve Cellz(SetCnt%)
Cellz(SetCnt%).SetNbr = x%
Cellz(SetCnt%).Val1 = Left(ActiveCell.Value, 1)
Cellz(SetCnt%).Val2 = Mid(ActiveCell.Value, 2, 1)
Cellz(SetCnt%).Val3 = Right(ActiveCell.Value, 1)
Cellz(SetCnt%).Addr = ActiveCell.Address
x% = x% + 1
ActiveCell.Offset(1, 0).Activate
Loop
'Start an iterative loop through all the sets, from which we will call TestSet()
to begin the recursive chain.
'If TRUE is returned, we found a solution!
For aa% = 0 To (SetCnt% - 1)
If TestSet(aa%, aa% + 1) = True Then
MsgBox "A solution was found."
MsgBox Cellz(SolnSet1).Addr & " = " & Range(Cellz(SolnSet1).Addr)
MsgBox Cellz(SolnSet2).Addr & " = " & Range(Cellz(SolnSet2).Addr)
Exit Sub
End If
Next aa%
MsgBox "No solution was found."
ReDim Cellz(0)
End Sub
Public Function TestSet(Set1 As Integer, Set2 As Integer) As Boolean
'Passes the values in Set1 and Set2 to be tested in another function. If test
succeeds,
'save as SolnSet1 and SolnSet2, then return TRUE. If test fails, keep Set1 the
same
'and make the next set Set2. Call TestSet again with these parameters.
If EvaluateSets(Set1, Set2) = True Then
SolnSet1% = Set1
SolnSet2% = Set2
'Make the cells with the solution sets BOLD.
Range(Cellz(SolnSet1).Addr).Font.Bold = True
Range(Cellz(SolnSet2).Addr).Font.Bold = True
TestSet = True
Exit Function
Else
If Set2 + 1 > SetCnt% Then
TestSet = False
Exit Function
ElseIf TestSet(Set1, Set2 + 1) = True Then
TestSet = True
Exit Function
End If
End If
TestSet = False
End Function
Public Function EvaluateSets(SetA As Integer, SetB As Integer) As Boolean
'Do some test on the two sets to determine if they are the right two. I'm just
'adding the two 3-digit numbers to see if they equal a certain sum.
If (Int(Cellz(SetA).Val1 & Cellz(SetA).Val2 & Cellz(SetA).Val3) + _
Int(Cellz(SetB).Val1 & Cellz(SetB).Val2 & Cellz(SetB).Val3)) = 1334 Then
EvaluateSets = True
Exit Function
Else
EvaluateSets = False
Exit Function
End If
End Function