Setting dynamic ranges in Excel VBA

[zapouk]

I don't do much in Excel VBA, mainly SQL (and previously with VB), but would like to know if I'm on the right track here or if there's a simpler way of thinking about it. I'm sure it's all been done before.

I've got a job that involves loading a spreadsheet with data from SQL Server. I don't have a problem with retrieving the data via ADO and a stored procedure, but I have found it very messy when working with ranges in VBA when you have to set a range based on an area of non-blank cells that can expand/contract and could be empty.

So came up with these routines that I hope to use elsewhere, not fully tested I hasten to add...
I chose to work only with row/column index values, if you use A1 notation you have to keep building strings that seems more messy. Don't know if this the best approach.

For module:

'***Change for version of Excel***
Private Const ExcelMaxRow = 1048576
Private Const ExcelMaxCol = 16384


Public Function GetRngArea(ThisSheet As Worksheet, StartRow As Long, StartCol As Long, _
    Optional EndRow As Long = -1, Optional EndCol As Long = -1, _
    Optional SearchColForEndRow As Long = -1, Optional SearchRowForEndCol As Long = -1) As Range


'Only works for an area of cells that can grow down and right to the edges of the worksheet
'Based on a top left anchor cell


'Valid combinations of input parameters:
'EndRow, EndCol                             Both known
'SearchColForEndRow, SearchRowForEndCol     Both unknown and searched to find first non-blank cell from edge of worksheet
'EndRow, SearchRowForEndCol                 One known, other searched to find first non-blank cell from edge of worksheet
'SearchColForEndRow, EndCol                 One known, other searched to find first non-blank cell from edge of worksheet


'Output parameter:
'Nothing if no area defined


Dim ThisEndRow As Long
Dim ThisEndCol As Long


On Error GoTo ThisErr


'go through the combinations of optional parameters
If EndRow <> -1 And SearchColForEndRow = -1 And EndCol <> -1 And SearchRowForEndCol = -1 Then
    ThisEndRow = EndRow
    ThisEndCol = EndCol


ElseIf EndRow = -1 And SearchColForEndRow <> -1 And EndCol = -1 And SearchRowForEndCol <> -1 Then
    ThisEndRow = GetLastRow(ThisSheet, SearchColForEndRow)
    ThisEndCol = GetLastCol(ThisSheet, SearchRowForEndCol)


ElseIf EndRow <> -1 And SearchColForEndRow = -1 And EndCol = -1 And SearchRowForEndCol <> -1 Then
    ThisEndRow = EndRow
    ThisEndCol = GetLastCol(ThisSheet, SearchRowForEndCol)


ElseIf EndRow = -1 And SearchColForEndRow <> -1 And EndCol <> -1 And SearchRowForEndCol = -1 Then
    ThisEndRow = GetLastRow(ThisSheet, SearchColForEndRow)
    ThisEndCol = EndCol
Else
    Err.Raise -9999
End If


'check for defined area
If (ThisEndRow < StartRow) Or (ThisEndCol < StartCol) Then
    Err.Raise -9998
End If


'return - OK if here
Set GetRngArea = ThisSheet.Range(Cells(StartRow, StartCol), Cells(ThisEndRow, ThisEndCol))


Exit Function


ThisErr:


If Err.Number = -9999 Then 'user-defined error - incorrct parameters
    Err.Raise -9999, "GetRngArea", "Incorrect parameters"
ElseIf Err.Number = -9998 Then  'user-defined error - no data
    Set GetRngArea = Nothing
Else 'unknown error
    Err.Raise Err.Number, Err.Source, Err.Description
End If


End Function


Public Function GetRngRow(ThisSheet As Worksheet, StartRow As Long, StartCol As Long, _
    Optional EndCol As Long = -1) As Range
    
'Only works for a row of cells that can grow right to the edge of the worksheet
'Based on a top left anchor cell
    
'Output parameter:
'Nothing if no row defined


Dim ThisEndCol As Long


On Error GoTo ThisErr


'go through the combinations of optional parameters!
If EndCol <> -1 Then
    ThisEndCol = EndCol
ElseIf EndCol = -1 Then
    ThisEndCol = GetLastCol(ThisSheet, StartRow)
End If


'check for defined row
If ThisEndCol < StartCol Then
    Err.Raise -9998
End If


'return - OK if here
Set GetRngRow = ThisSheet.Range(Cells(StartRow, StartCol), Cells(StartRow, ThisEndCol))


Exit Function


ThisErr:


If Err.Number = -9998 Then  'user-defined error - no data
    Set GetRngRow = Nothing
Else 'unknown error
    Err.Raise Err.Number, Err.Source, Err.Description
End If


End Function


Public Function GetRngCol(ThisSheet As Worksheet, StartRow As Long, StartCol As Long, _
    Optional EndRow As Long = -1) As Range
    
'Only works for a column of cells that can grow down to the edge of the worksheet
'Based on a top left anchor cell
    
'Output parameter:
'Nothing if no column defined


Dim ThisEndRow As Long


On Error GoTo ThisErr


'go through the combinations of optional parameters!
If EndRow <> -1 Then
    ThisEndRow = EndRow
ElseIf EndRow = -1 Then
    ThisEndRow = GetLastRow(ThisSheet, StartCol)
End If


'check for defined column
If ThisEndRow < StartRow Then
    Err.Raise -9998
End If


'return - OK if here
Set GetRngCol = ThisSheet.Range(Cells(StartRow, StartCol), Cells(ThisEndRow, StartCol))


Exit Function


ThisErr:


If Err.Number = -9998 Then  'user-defined error - no data
    Set GetRngCol = Nothing
Else 'unknown error
    Err.Raise Err.Number, Err.Source, Err.Description
End If


End Function


Public Function GetLastRow(ThisSheet As Worksheet, SearchCol As Long) As Long
'Find last row based on search column, going up from cell in column at bottom edge of sheet to first non-blank cell


Dim MaxRow As Long
MaxRow = ExcelMaxRow
GetLastRow = ThisSheet.Range(Cells(MaxRow, SearchCol), Cells(MaxRow, SearchCol)).End(xlUp).Row


End Function


Public Function GetLastCol(ThisSheet As Worksheet, SearchRow As Long) As Long
'Find last column based on search row, going left from cell at right edge of sheet to first non-blank cell


Dim MaxCol As Long
MaxCol = ExcelMaxCol
GetLastCol = ThisSheet.Range(Cells(SearchRow, MaxCol), Cells(SearchRow, MaxCol)).End(xlToLeft).Column


End Function

And for testing:

Private Sub CommandButton1_Click()
Dim ThisWorkbook As Workbook
Dim ThisSheet As Worksheet
Dim ThisRange As Range


Set ThisWorkbook = Application.ActiveWorkbook
Set ThisSheet = ThisWorkbook.ActiveSheet


ThisSheet.Range("A1") = ""


Set ThisRange = GetRngArea(ThisSheet, 2, 3, 7, 8)
If ThisRange Is Nothing Then
    ThisSheet.Range("A1") = "Nothing"
Else
    ThisRange.Select
End If


End Sub

Thanks in advance for any suggestions.

 

[wigi]

I only checked your last 2 functions, but they can be simplified:

Public Function GetLastRow(ThisSheet As Worksheet, SearchCol As Long) As Long
'Find last row based on search column, going up from cell in column at bottom edge of sheet to first non-blank cell

    GetLastRow = ThisSheet.Cells(ExcelMaxRow, SearchCol).End(xlUp).Row

End Function

Public Function GetLastCol(ThisSheet As Worksheet, SearchRow As Long) As Long
'Find last column based on search row, going left from cell at right edge of sheet to first non-blank cell

    GetLastCol = ThisSheet.Cells(SearchRow, ExcelMaxCol).End(xlToLeft).Column

End Function

 

[wigi]

Make sure you apply the worksheet (ThisSheet) to the cells as well.
This code for example:

Set GetRngRow = ThisSheet.Range(Cells(StartRow, StartCol), Cells(StartRow, ThisEndCol))

will break when ThisSheet is not the activesheet.

 

[zapouk]

I only checked your last 2 functions, but they can be simplified:

Public Function GetLastRow(ThisSheet As Worksheet, SearchCol As Long) As Long
'Find last row based on search column, going up from cell in column at bottom edge of sheet to first non-blank cell

    GetLastRow = ThisSheet.Cells(ExcelMaxRow, SearchCol).End(xlUp).Row

End Function

Public Function GetLastCol(ThisSheet As Worksheet, SearchRow As Long) As Long
'Find last column based on search row, going left from cell at right edge of sheet to first non-blank cell

    GetLastCol = ThisSheet.Cells(SearchRow, ExcelMaxCol).End(xlToLeft).Column

End Function

Thanks for that. Not really knowing Excel VBA I found it confusing that you can do Range("A1") but not Range(Cells(1, 1)).


Also realised that GetLastRow (or GetLastCol) will always return a value >= 1, even if the entire search column is empty. So need to test for it returning 1 and this cell at the top edge also being blank.