G'day there One and All,

I have a smallish problem upon which has brought my undeveliped
programming skills to a halt. Hence, here I am.

I have a roster sheet with a row of dates across one of the top
rows. There could be 14 or 28 dates, depending on the users'
requirements, and there is no consistency as to which row might be used.
There may even be another row further down the sheet.

I need to search those dates and then scan down the columns under
the date being tested. That bit works. However I've found that some of
my users have a duplicated the row of dates with one row formatted for
the date and another formatted for day of the week. This is fine, but my
code is detecting both rows and searching each one. Hence I get 2 hits
and 2 searches for each target date. The results are processed to remove
duplicates in any case, but it's an overhead I don't need.

I've written the following code:

Public Function dateRanges(objWKS As Worksheet) As Range
' Returns addresses of groups of contiguous ells containing dates
Dim cell As Range
Dim iX As Integer
Dim rngX
' Set to range consisting of all cells with date format
For Each cell In objWKS.UsedRange.Cells
If TypeName(cell.Value) = "Date" Then
If dateRanges Is Nothing Then
Set dateRanges = cell
Else
Set dateRanges = Union(dateRanges, cell)
End If
End If
Next
' Then reduce to set of contiguous cells
rngX = Split(dateRanges.Address, ",")
Set dateRanges = Nothing
For iX = LBound(rngX) To UBound(rngX)
If Not InStr(1, rngX(iX), ":") = 0 Then
If dateRanges Is Nothing Then
Set dateRanges = Range(rngX(iX))
Else
Set dateRanges = Union(dateRanges, Range(rngX(iX)))
End If
End If
Next
End Function

...which gives me a range of all dates that occur in contiguous
cells. Single cells with dates are excluded. This is what I want.

However, what I now need is some way to remove the 2nd row from a
range such as "A4:AE5". I only need the top or bottom row, not both. I
was thinking a judicious application of - dateRanges.row - might be
useful, but I can't figure out how to make it work.

If it should happen that I get a union for 2 rows of dates, eg.
"A4:AE5, A20:AE21" I can easily use split as above and process each
single range before reassembling the components. However firstly I need
to remove one of the rows and that's got me stuck.

Any suggestions will be gratefully accepted (except those
suggestions involving my anatomy <g ).

--
Thanks for listening,
See ya,
Ken McLennan
Qld, Australia

Sub TryNow()
Dim myArea As Range
Dim dateRange As Range
Dim dateRanges As Range
Set dateRanges = Range("A4:AE5, A20:AE21")

For Each myArea In dateRanges.Areas
If myArea.Rows.Count 1 Then

Set dateRange = myArea.Rows(1)
MsgBox "From " & myArea.Address & _
" I have selected " & dateRange.Address
End If
Next myArea

End Sub



HTH,
Bernie
MS Excel MVP


"Ken McLennan" wrote in message
...
G'day there One and All,

I have a smallish problem upon which has brought my undeveliped
programming skills to a halt. Hence, here I am.

I have a roster sheet with a row of dates across one of the top
rows. There could be 14 or 28 dates, depending on the users'
requirements, and there is no consistency as to which row might be used.
There may even be another row further down the sheet.

I need to search those dates and then scan down the columns under
the date being tested. That bit works. However I've found that some of
my users have a duplicated the row of dates with one row formatted for
the date and another formatted for day of the week. This is fine, but my
code is detecting both rows and searching each one. Hence I get 2 hits
and 2 searches for each target date. The results are processed to remove
duplicates in any case, but it's an overhead I don't need.

I've written the following code:

Public Function dateRanges(objWKS As Worksheet) As Range
' Returns addresses of groups of contiguous ells containing dates
Dim cell As Range
Dim iX As Integer
Dim rngX
' Set to range consisting of all cells with date format
For Each cell In objWKS.UsedRange.Cells
If TypeName(cell.Value) = "Date" Then
If dateRanges Is Nothing Then
Set dateRanges = cell
Else
Set dateRanges = Union(dateRanges, cell)
End If
End If
Next
' Then reduce to set of contiguous cells
rngX = Split(dateRanges.Address, ",")
Set dateRanges = Nothing
For iX = LBound(rngX) To UBound(rngX)
If Not InStr(1, rngX(iX), ":") = 0 Then
If dateRanges Is Nothing Then
Set dateRanges = Range(rngX(iX))
Else
Set dateRanges = Union(dateRanges, Range(rngX(iX)))
End If
End If
Next
End Function

...which gives me a range of all dates that occur in contiguous
cells. Single cells with dates are excluded. This is what I want.

However, what I now need is some way to remove the 2nd row from a
range such as "A4:AE5". I only need the top or bottom row, not both. I
was thinking a judicious application of - dateRanges.row - might be
useful, but I can't figure out how to make it work.

If it should happen that I get a union for 2 rows of dates, eg.
"A4:AE5, A20:AE21" I can easily use split as above and process each
single range before reassembling the components. However firstly I need
to remove one of the rows and that's got me stuck.

Any suggestions will be gratefully accepted (except those
suggestions involving my anatomy <g ).

--
Thanks for listening,
See ya,
Ken McLennan
Qld, Australia

G'day there Bernie,

For Each myArea In dateRanges.Areas
If myArea.Rows.Count 1 Then

Well, it's simple when you put it like that!!!! <g

Thanks very much. I've not tried it yet, but I at least understand
what you've written and how it works. I can't see any reason why this
shouldn't do the trick and I'll try it this afternoon. I can't try it
this morning as my wife is making me go to the gym and then do some work
about the house. One day when I grow up I'll have a life of my own =)

Thanks again, I appreciate your help.

--
See ya,
Ken McLennan
Qld, Australia

G'day there Bernie,

For Each myArea In dateRanges.Areas
If myArea.Rows.Count 1 Then

I tried it this afternoon and it worked like a charm. I just added
a few little bits 'n' bobs to catch empty variables and where "Range is
Nothing", and it's up and running.

Thanks once again for your assistance.
--
See ya,
Ken McLennan
Qld, Australia