Excel VBA | Include Blank Cells Below an Already Selected Cell In a Range

Question

I have a script partially written. I'm stuck on how to include all blank cells below a selected cell and store this as a range. My script selects the top cell in the range I want - Cell N39 - and I want to select each of the blank cells below it. That is, I want to select N39 thru N42 and name it as a range.

I know there are other ways to capture this range (ie - all of the "BlankNonUSD" descriptions I add on the far right could help me). But the only way I can grab only the data I need and not accidentally include data I don't need is to select this "N39" cell and every empty cell below it. I want to ensure this script can run for all sheets it will be used for and this is the way to do it.

I have my script below and a link to the picture of the sheet I referenced. Any help would be highly appreciated!

Script:

'Convert "BlankNonUSD" and move values to "Amount USD" (Column N)
For i = 1 To IDLastRow
    If Cells(i, 16) = "BlankNonUSD" And Cells(i, 14) <> "" Then
        Range("N" & i).Select
        'This is where I also want to select all cells below
            'Dim r As Range
            'Set r = Selection
           
                'Dim x As Integer
                'Dim y As Integer
                'x = r.Rows
                'y = r.Rows.Count + x - 1
        'Dim USDTotal As Integer
        'USDTotal = Range("N" & i).Value
        'Dim nonUSDTotal As Integer
        'nonUSDTotal = ActiveSheet.Sum(r)
        'For Z = x To y
            'Cells(i, 17) = Round(((Cells(i, 14).Value / nonUSDTotal) * USDTotal), 2)
        'Next


    End If
     
Next

Picture of Sheet

Answer 1

Reference Cell and Blanks Adjacent to the Bottom

• In your code you would call the function in the following way:

   RefCellBottomBlanks(Range("N" & i)).Select

The Function

Function RefCellBottomBlanks( _
    ByVal FirstCell As Range) _
As Range
    With FirstCell.Cells(1)
        Dim lCell As Range: Set lCell = _
            .Resize(.Worksheet.Rows.Count - .Row + 1).Find("*", , xlValues)
        If lCell Is Nothing Then Exit Function ' no data in column
        If lCell.Row <= .Row + 1 Then ' no blanks adjacent to the bottom
            Set RefCellBottomBlanks = .Cells
        Else
            Set RefCellBottomBlanks = .Resize(lCell.Row - .Row)
        End If
    End With
End Function

A Test Procedure

Sub RefCellBottomBlanksTEST()
    
    Const fCellAddress As String = "N39"
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim fCell As Range: Set fCell = ws.Range(fCellAddress)
    Dim rg As Range: Set rg = RefCellBottomBlanks(fCell)
    
    Debug.Print rg.Address

End Sub