Run-time error 6 overflow

I have this code and giving me this error "Run-Time error 6, overflow"

here is the line of code highlighting the error:

For i = 1 To (2 ^ UBound(aToUse)) - 1

Complete code:

Sub SumToTarget()
    
    Dim vaInput As Variant
    Dim i As Long, j As Long
    Dim aBinary() As Byte
    Dim lCnt As Long
    Dim dTarget As Double
    Dim dThisTotal As Double
    Dim dBest As Double, vaBest As Variant
    Dim aToUse() As Double
    Dim dAllPos As Double, dAllNeg As Double
    Dim snStart As Single
    Dim aResult() As Long
    Dim dMaxFind As Double
    
    ThisWorkbook.Save
    
    snStart = Timer
    
    wshCalc.Unprotect
    wshCalc.Range("rngList").Offset(0, 1).ClearContents
    vaInput = wshCalc.Range("rngList").Value
    dBest = Application.WorksheetFunction.Sum(vaInput)
    dTarget = wshCalc.Range("rngTarget").Value
    
    If IsEmpty(wshCalc.Range("rngMaxFind").Value) Then
        dMaxFind = UBound(vaInput, 1)
    Else
        dMaxFind = wshCalc.Range("rngMaxFind").Value
    End If
    
    ReDim aResult(1 To UBound(vaInput, 1), 1 To 1)
    ReDim aToUse(1 To UBound(vaInput, 1))
        
    For i = LBound(vaInput, 1) To UBound(vaInput, 1)
        If vaInput(i, 1) < 0 Then
            dAllNeg = dAllNeg + vaInput(i, 1)
        Else
            dAllPos = dAllPos + vaInput(i, 1)
        End If
    Next i
    
    For i = LBound(vaInput, 1) To UBound(vaInput, 1)
        If vaInput(i, 1) + dAllPos >= dTarget And vaInput(i, 1) + dAllNeg <= dTarget And vaInput(i, 1) <> 0 Then
            lCnt = lCnt + 1
            aToUse(lCnt) = vaInput(i, 1)
            aResult(i, 1) = -1
        Else
            aResult(i, 1) = 0
        End If
    Next i
    
    If lCnt >= 1 Then
        ReDim Preserve aToUse(1 To lCnt)
        
        For i = 1 To (2 ^ UBound(aToUse)) - 1
            dThisTotal = 0
            aBinary = DecToBin(i, UBound(aToUse))
            
            If Application.WorksheetFunction.Sum(aBinary) <= dMaxFind Then
                For j = 1 To UBound(aBinary)
                    If CBool(aBinary(j)) Then
                        dThisTotal = dThisTotal + aToUse(j)
                    End If
                Next j
                
                If Abs(dThisTotal - dTarget) <= Abs(dBest - dTarget) Then
                    dBest = dThisTotal
                    vaBest = aBinary
                    If dThisTotal = dTarget Then Exit For
                End If
            End If
        Next i
        
        For i = LBound(vaBest) To UBound(vaBest)
            For j = LBound(aResult) To UBound(aResult)
                If aResult(j, 1) = -1 Then
                    aResult(j, 1) = vaBest(i)
                    Exit For
                End If
            Next j
        Next i
        
        wshCalc.Range("rngList").Cells(1).Offset(0, 1).Resize(UBound(aResult), 1).Value = aResult
    End If
    
    'wshCalc.Protect
    Debug.Print Timer - snStart
    
End Sub

thank you,