# Visual Basic > Office Development >  Excel: Create ranges for date and blank cells

## MartinLiss

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.

----------


## Zvoni

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 


```
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


```
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
```

----------

