Help with correct code to set a 2nd range (Macro)

[GrantD]

Goodday

I need some help to set a second range on the following macro so that the highlighted code looks at column (B2-B) on the odds even sub only. It currently is set on Column A
Any help greatly appreciated as I dont know what to change How will I set Column B on just a sub without changing the default range?

Sub GetCombos()
    
   [B] Dim rngNumbers As Range[/B]
    Dim i As Long, j As Long, k As Long
    Dim colResults As New Collection
    Dim arrResults() As String
    Dim arrOddEvenTest() As String
    Dim arrComboLoc As Variant
    Dim LocIndex As Long
    Dim TestIndex As Long
    Dim dTot As Double
    Dim str As String
    Dim dTargetSum As Double
    Dim bAdvanced As Boolean
    Dim bValid As Boolean
    Dim lNumOdd As Long, lTotOdd As Long
    Dim lNumEven As Long, lTotEven As Long
    
    
   [B] Set rngNumbers = Range("A2", Cells(Rows.Count, "A").End(xlUp))
    Range("F2:F" & Rows.Count).ClearContents[/B]
    
    If Not IsNumeric(Range("D2").Value) _
    Or Len(Trim(Range("D2").Value)) = 0 Then
        Range("D2").Select
        MsgBox "Must provide a Target SUM number"
        Exit Sub
    End If
    
    If Not IsNumeric(Range("D3").Value) _
    Or Len(Trim(Range("D3").Value)) = 0 Then
        Range("D3").Select
        MsgBox "Must provide the number of cells to use"
        Exit Sub
    ElseIf Range("D3").Value > rngNumbers.Cells.Count Then
        Range("D3").Select
        MsgBox "Number of cells may not exceed total amount of cells"
        Exit Sub
    ElseIf Range("D3").Value < 1 Then
        Range("D3").Select
        MsgBox "Number of cells may not be less than 1"
        Exit Sub
    End If
    
   [B] If Not IsNumeric(Range("D4").Value) _
    Or Len(Trim(Range("D4").Value)) = 0 Then
        Range("D4").Select
        MsgBox "Must provide the # of Odds required"
        Exit Sub
    End If[/B]
    
    dTargetSum = Range("D2").Value
    arrComboLoc = Application.Transpose(Evaluate("Index(Row(1:" & Range("D3").Value & "),)"))
   [B] lNumOdd = Range("D4").Value
    lNumEven = Range("D5").Value[/B]
    
    On Error Resume Next
    For i = 1 To WorksheetFunction.Combin(rngNumbers.Count, Range("D3").Value)
        dTot = 0
        str = vbNullString
        For LocIndex = LBound(arrComboLoc) To UBound(arrComboLoc)
            dTot = dTot + rngNumbers.Cells(arrComboLoc(LocIndex)).Value
            str = str & ", " & rngNumbers.Cells(arrComboLoc(LocIndex)).Value
        Next LocIndex
        If dTot = dTargetSum Then
            str = Mid(str, 3)
            lTotOdd = 0
            lTotEven = 0
            bValid = True
            arrOddEvenTest = Split(str, ", ")
            For TestIndex = LBound(arrOddEvenTest) To UBound(arrOddEvenTest)
                If arrOddEvenTest(TestIndex) = 0 Then
                    lTotOdd = lTotOdd + 1
                    If lTotOdd > lNumOdd Then
                        bValid = False
                        Exit For
                    End If
                Else
                    Select Case (arrOddEvenTest(TestIndex) / 2 = Int(arrOddEvenTest(TestIndex) / 2))
                        Case True:  lTotEven = lTotEven + 1
                                    If lTotEven > lNumEven Then
                                        bValid = False
                                        Exit For
                                    End If
                        Case Else:  lTotOdd = lTotOdd + 1
                                    If lTotOdd > lNumOdd Then
                                        bValid = False
                                        Exit For
                                    End If
                    End Select
                End If
            Next TestIndex
            If bValid = True Then colResults.Add str, str
        End If
        
        bAdvanced = False
        For j = UBound(arrComboLoc) To LBound(arrComboLoc) Step -1
            If arrComboLoc(j) < rngNumbers.Cells.Count - (UBound(arrComboLoc) - j) Then
                arrComboLoc(j) = arrComboLoc(j) + 1
                For k = j + 1 To UBound(arrComboLoc)
                    arrComboLoc(k) = arrComboLoc(j) + k - j
                Next k
                bAdvanced = True
                Exit For
            End If
            If bAdvanced = True Then Exit For
        Next j
    Next i
    
    If colResults.Count > 0 Then
        ReDim Preserve arrResults(1 To colResults.Count)
        For i = 1 To colResults.Count
            arrResults(i) = colResults(i)
        Next i
        Range("F2").Resize(colResults.Count).Value = Application.Transpose(arrResults)
    Else
        MsgBox "No valid combinations found to be less than or equal to " & dTargetSum & " when using " & Range("D3").Value & " cells."
    End If
    
End Sub

 

[GrantD]

Bump anyone .........