Option Explicit 
 
Sub SumFind() 
     
    Dim MR As Range 
    Dim dx As Double 
    Dim cell As Range 
    Dim cell2 As Range 
    Dim MySum As Double 
    Dim i As Integer 
    Dim k As Integer 
    Dim stTotally As String 
     
    stTotally = "The pair of ranges are:" & Chr(10) 'setting the result message
    k = 0 
     
    On Error GoTo CancelOption 
     
     'getting the range in which the search will be executed
    Set MR = Application.InputBox(Prompt:="Select the range containing the numbers", Title:="STEP1", Type:=8) 
    If MR.Cells.Count < 2 Then 
        MsgBox "Select an appropriate range of numbers (at least two)", vbOKOnly + vbCritical, "Error" 
        Exit Sub 
    End If 
     
     'getting the number you're looking for
    dx = Application.InputBox(Prompt:="Input the number you're looking for as the result of the sum of two numbers", Title:="STEP 2", Type:=1) 
    If IsNull(dx) Then 
        MsgBox "Input an appropriate number", vbOKOnly + vbCritical, "Error" 
        Exit Sub 
    End If 
    If dx = 0 Then GoTo CancelOption 
     
     'find the pairs of cells
    For Each cell In MR 
        For i = 1 To MR.Cells.Count 
            Set cell2 = MR.Cells(i) 
            MySum = (cell.Value + cell2.Value) 
            If MySum = dx Then 
                If cell.Address <> cell2.Address Then 
                    k = k + 1 
                    stTotally = stTotally & Chr(10) & k & ") " & cell.Address(False, False, xlA1) & " - " & cell2.Address(False, False, xlA1) 
                End If 
            End If 
        Next i 
    Next cell 
     
     'display results
    Select Case stTotally 
         
    Case "The pair of ranges are:" & Chr(10) 
         
        MsgBox "No ranges match", vbOKOnly, "Report" 
         
    Case Else 
         
        MsgBox stTotally, vbOKOnly, "Report" 
         
    End Select 
     
     
CancelOption: 
     
     'clearing
    Set MR = Nothing 
    Set cell = Nothing 
    Set cell2 = Nothing 
End Sub