Expanding on Tushar Mehta code?

[savosean]

Hello, I was wondering if anyone could assist me in expanding on Tushar Mehta code for finding the possible values that would sum a total as my knowledge of VBA is very limited.

As of now I have a list of data, and within that data I search to find what values may sum together to equal 0. The code works great, the only thing I was wondering is if instead of it outputting the line items that can be sum'd together to equal 0 if it could highlight those values instead. As currently I can have an output of 30+ lines that can sum 0 and this make things a lot longer.

the current code is

Option Explicit

Function RealEqual(A, B, Epsilon As Double)
    RealEqual = Abs(A - B) <= Epsilon
    End Function
Function ExtendRslt(CurrRslt, NewVal, Separator)
    If CurrRslt = "" Then ExtendRslt = NewVal _
    Else ExtendRslt = CurrRslt & Separator & NewVal
    End Function

Sub recursiveMatch(ByVal MaxSoln As Integer, ByVal TargetVal, InArr(), _
        ByVal CurrIdx As Integer, _
        ByVal CurrTotal, ByVal Epsilon As Double, _
        ByRef Rslt(), ByVal CurrRslt As String, ByVal Separator As String)
    Dim I As Integer
    For I = CurrIdx To UBound(InArr)
        If RealEqual(CurrTotal + InArr(I), TargetVal, Epsilon) Then
            Rslt(UBound(Rslt)) = (CurrTotal + InArr(I)) _
                & Separator & Format(Now(), "hh:mm:ss") _
                & Separator & ExtendRslt(CurrRslt, I, Separator)
            If MaxSoln = 0 Then
                If UBound(Rslt) Mod 100 = 0 Then Debug.Print UBound(Rslt) & "=" & Rslt(UBound(Rslt))
            Else
                If UBound(Rslt) >= MaxSoln Then Exit Sub
                End If
            ReDim Preserve Rslt(UBound(Rslt) + 1)
        ElseIf CurrTotal + InArr(I) > TargetVal + Epsilon Then
        ElseIf CurrIdx < UBound(InArr) Then
            recursiveMatch MaxSoln, TargetVal, InArr(), I + 1, _
                CurrTotal + InArr(I), Epsilon, Rslt(), _
                ExtendRslt(CurrRslt, I, Separator), _
                Separator
            If MaxSoln <> 0 Then If UBound(Rslt) >= MaxSoln Then Exit Sub
        Else
            'we've run out of possible elements and we _
             still don't have a match
            End If
        Next I
    End Sub

Function ArrLen(Arr()) As Integer
    On Error Resume Next
    ArrLen = UBound(Arr) - LBound(Arr) + 1
    End Function

Sub startSearch()
    'The selection should be a single contiguous range in a single column. _
     The first cell indicates the number of solutions wanted.  Specify zero for all. _
      The 2nd cell is the target value. _
      The rest of the cells are the values available for matching. _
      The output is in the column adjacent to the one containing the input data.
    Dim TargetVal, Rslt(), InArr(), StartTime As Date, MaxSoln As Integer
    StartTime = Now()
    MaxSoln = Selection.Cells(1).Value
    TargetVal = Selection.Cells(2).Value
    InArr = Application.WorksheetFunction.Transpose( _
        Selection.Offset(2, 0).Resize(Selection.Rows.Count - 2).Value)
    ReDim Rslt(0)
    recursiveMatch MaxSoln, TargetVal, InArr, LBound(InArr), 0, 0.00000001, _
        Rslt, "", ", "
    Rslt(UBound(Rslt)) = Format(Now, "hh:mm:ss")
    ReDim Preserve Rslt(UBound(Rslt) + 1)
    Rslt(UBound(Rslt)) = Format(StartTime, "hh:mm:ss")
    Selection.Offset(0, 1).Resize(ArrLen(Rslt), 1).Value = _
        Application.WorksheetFunction.Transpose(Rslt)
    End Sub

This would get me for example an output like this

0, 10:43:42, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 32, 33, 34, 35, 36, 38, 39, 40, 41, 43, 44, 45, 47, 48, 50

In the column adjacent to the one containing the data. Can I somehow find an alternative where I don't have to manually look at that giant output and highlight the line items my self, and have it completed this task automatically? Or if maybe someone knows of a more efficient way, with a formula I can use on top of the code?

Sorry if I am not making much sense, if you need me to clarify I will do my best to re explain.