Excel: Create ranges for date and blank cells
In column 'A' I have data that looks like this starting in row 3. The number of dates and blanks between the dates are variable. I'd like to do it without stepping through every row.
Date
Blank
Blank
Blank
Date
Blank
Blank
Blank
Blank
In a loop starting in row 3 I'd like to set a range with an address of A3:A6, and then set a second range with an address of A7:A50. The 50 is a hard-coded value to prevent the range from being A7:A1048576.
Thanks in advance for the help.
Re: Excel: Create ranges for date and blank cells
Since you say "Loop" i take it it's vba.
If you're alread in a loop, what's wrong with checking the cells in Column A if they're empty/blank?
Some speed up might be gained with
Code:
Public Function GetLastRow(ByVal ASheetName As String, Optional ByVal AColumn As String = "A") As Long
GetLastRow = Worksheets(ASheetName).Cells(Worksheets(ASheetName).Rows.Count, AColumn).End(xlUp).Row
End Function
Pass the Sheetname, and you get the last non-empty row in column A (for your second range "A7:A50" that would be 7)
Aircode
Code:
Public Function GetLastRow(ByVal ASheetName As String, Optional ByVal AColumn As String = "A") As Long
GetLastRow = Worksheets(ASheetName).Cells(Worksheets(ASheetName).Rows.Count, AColumn).End(xlUp).Row
End Function
Sub SetRangeName(ByRef ASheetName As String)
Dim lr As Long
Dim i As Long
Dim j As Long
Dim c As Long
Dim b As Boolean
Dim ws As Worksheet
Dim arrRanges() As Range
c = 0
Set ws = Worksheets(ASheetName)
ReDim arrRanges(0 To c)
lr = GetLastRow(ASheetName)
b = True
For i = 3 To lr
If ws.Cells(i, 1) <> "" Then
If b Then
j = i
b = False
Else
Set arrRanges(c) = ws.Range("$A$" & j & ":$A$" & i - 1)
ReDim Preserve arrRanges(0 To c + 1)
c = UBound(arrRanges)
j = i
End If
End If
Next
Set arrRanges(c) = ws.Range("$A$" & lr & ":$A$50")
End Sub
Sub Test()
SetRangeName "Sheet1"
End Sub