Gift for the Community (Select Any Part of a Range)

[Jeffrey Mahoney]

The Function below allows you to return a smaller section of a range provided. Returnable ranges are:
- a cell
- a range
- a row
- a column
- multiple rows or columns
- last row or column
- multiple rows at the bottom
- multiple columns on the right

All I ask is that you LIKE this or post you comments. Suggestions for improvement are welcomed.

Jeff

--------------------------------------------------------------------------
All returned ranges are relative to the range provided. Here are some examples:


Return the Top Left Cell

Sub TestPOR2()
  POR2(Selection, 1, 1, 0, 0).Select
End Sub

Return the Bottom Right Cell

Sub TestPOR2()
  POR2(Selection, -1, -1, 0, 0).Select
End Sub

Return the Top Right Cell

Sub TestPOR2()
  POR2(Selection, 1, -1, 0, 0).Select
End Sub

Return the Bottom Left Cell

Sub TestPOR2()
  POR2(Selection, -1, 1, 0, 0).Select
End Sub

Return the 3rd and 4th rows; or two rows tall starting at the 3rd row

Sub TestPOR2()
  POR2(Selection, 3, 0, 2, 0).Select
End Sub

Return the 10th column

Sub TestPOR2()
  POR2(Selection, 0, 10, 0, 0).Select
End Sub

Return the 4th row

Sub TestPOR2()
  POR2(Selection, 4, 0, 0, 0).Select
End Sub

Return the a range at the bottom right of the range that is 2 rows tall and 2 columns wide

Sub TestPOR2()
  POR2(Selection, -2, -2, 2, 2).Select
End Sub

'Definitions for POR2 (Part Of Range 2)
'-------------------
'R is the entire range
'aRow is the row number you want; returns only the column if zero; returns the last row or above for negative value
'aCol is the column number you want; returns only the row if zero; returns the last last column or left for negative value
'aRows is the number of rows to return; assumed to be 1; a value less than 2 is ignored
'aCols is the number of columns to return; assumed to be 1; a value less than 2 is ignored

'if aCol and aRow are both non-zero values it returns a cell at that index
'if aRow or aCol are greater than the number of rows or columns it returns the last row or column
'if aRow is -1 it returns the last row
'if aCol is -1 it returns the last column

'Row and Column values are relative to R
Function POR2(ByVal R As Range, ByVal aRow As Long, ByVal aCol As Long, ByVal aRows As Long, ByVal aCols As Long) As Range
  Dim Cel As Range
  Dim Rows As Long
  Dim Cols As Long
  Dim Rng As Range
  Dim Col As Long
  Dim Row As Long
  
  Rows = R.Rows.Count                       'Count of total Rows in R
  Cols = R.Columns.Count                    'Count of total Columns in R
  Set Cel = R.Resize(1, 1)
  If aRow < 0 Then aRow = Rows + 1 + aRow   'if negative, turn to positive row
  If aCol < 0 Then aCol = Cols + 1 + aCol   'if negative, turn to positive col
  
  
  If aRow <> 0 And aCol = 0 Then                              'Only a Row value provided
    aRow = Application.Max(Application.Min(aRow, Rows), 1)
    If aRows < 2 Then                                         'Select only a row
      Set Rng = R.Rows(aRow)
    Else                                                      'Select multiple rows
      aRows = Application.Min(aRows + aRow - 1, Rows)
      Set Rng = Range(R.Rows(aRow), R.Rows(aRows))
    End If
  
  ElseIf aRow <> 0 And aCol <> 0 Then                         'Row and Column Provided
    aRow = Application.Max(Application.Min(aRow, Rows), 1)
    aCol = Application.Max(Application.Min(aCol, Cols), 1)
    If aRows < 2 And aCols < 2 Then                           'Select a cell
      Set Rng = Cel.Offset(aRow - 1, aCol - 1)
    ElseIf aRows > 1 Or aCols > 1 Then                        'Select a Range
      aRows = Application.Min(aRows + aRow - 1, Rows)
      aCols = Application.Min(aCols + aCol - 1, Cols)
      Set Rng = Range(Cel.Offset(aRow - 1, aCol - 1), Cel.Offset(aRows - 1, aCols - 1))
    End If
  
  ElseIf aCol <> 0 And aRow = 0 Then                          'Only a Column value provided
    aCol = Application.Max(Application.Min(aCol, Cols), 1)
    If aCols < 2 Then                                         'Select only a column
      Set Rng = R.Columns(aCol)
    Else                                                      'Select multiple columns
      aCols = Application.Min(aCols + aCol - 1, Cols)
      Set Rng = Range(R.Columns(aCol), R.Columns(aCols))
    End If
  End If
  
  If Not Rng Is Nothing Then                'Everything went well :)
    Set POR2 = Rng
  Else                                      'User didn't supply the right values; original range
    Set POR2 = R
  End If
    
End Function