```
Public Function CheckCheques(InCol As String, OutCol As String, InTot As Double) As Boolean
Dim LoopCnt As Double, RowNum As Integer, TotNum As Double, Cnt As Integer, Lastrow As Integer
Dim Arr() As Variant, ArCnt As Integer, LetterArr() As Variant, LetCnt As Integer
'Outputs different combos of data input to produce searched total
'InCol is search data Column
'OutCol is output column. Outputs x3 possible combos (X,Y,Z).
'Add X 's, Y's or Z's together for different combos
'InTot is total being searched for
With Sheets("Sheet1")
Lastrow = .Range(InCol & .Rows.Count).End(xlUp).Row
.Range(OutCol & "2:" & OutCol & Lastrow).Clear
End With
If Lastrow = 1 Then
Exit Function
End If
LetCnt = 0
ArCnt = 0
LetterArr = Array("X", "Y", "Z")
Randomize
above:
LoopCnt = LoopCnt + 1
'change iterations to suit
If LoopCnt = 1000 Or LetCnt = 3 Then
Exit Function
End If
getnewrow:
RowNum = Int((Lastrow * Rnd) + 1)
If RowNum <> 1 Then
If ArCnt <> 0 Then
For Cnt = LBound(Arr) To UBound(Arr)
If Arr(Cnt) = RowNum Then
GoTo above
End If
Next Cnt
End If
'exclude blank cells
If Sheets("Sheet1").Range(InCol & RowNum) = vbNullString Then
GoTo getnewrow
End If
TotNum = TotNum + CDbl(Sheets("Sheet1").Range(InCol & RowNum))
If TotNum = InTot Then
CheckCheques = True
ArCnt = ArCnt + 1
ReDim Preserve Arr(ArCnt)
Arr(ArCnt - 1) = RowNum
For Cnt = LBound(Arr) To UBound(Arr) - 1
If Sheets("Sheet1").Range(OutCol & Arr(Cnt)) = vbNullString Then
Sheets("Sheet1").Range(OutCol & Arr(Cnt)) = LetterArr(LetCnt)
Else
Sheets("Sheet1").Range(OutCol & Arr(Cnt)) = Sheets("Sheet1").Range(OutCol & Arr(Cnt)) _
& "," & LetterArr(LetCnt)
End If
Next Cnt
LetCnt = LetCnt + 1
End If
If TotNum < InTot Then
ArCnt = ArCnt + 1
ReDim Preserve Arr(ArCnt)
Arr(ArCnt - 1) = RowNum
Else
ArCnt = 0
ReDim Arr(0)
TotNum = 0
End If
GoTo above
Else
GoTo above
End If
End Function
```