Copy first data row and last data row below the heading

[adamsm]

Hi anyone,

How could I figure out a code or a formula that would place the content of the first data row below the row 16 (of column "Q") on cell "A1" and the last data row of column "Q" in cell B1 of the active sheet.

Any help on this would be kindly appreciated.

Thanks in advance.

[GTO]

Presuming you want this for all sheets (the Active sheet), maybe:

In the ThisWorkbook Module:
[vba]Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngFoundCell As Range
Dim FirstAddress As String

If Not Application.Intersect(Target, Range("Q:Q")) Is Nothing Then
Application.EnableEvents = False

Set rngFoundCell = _
RangeFound(Range(Sh.Range("Q17"), Sh.Range("Q" & Sh.Rows.Count)), , _
Sh.Range("Q" & Sh.Rows.Count), , , , xlNext)

If Not rngFoundCell Is Nothing Then
FirstAddress = rngFoundCell.Address
Sh.Range("A1").Value = rngFoundCell.Value
Set rngFoundCell = Nothing

Set rngFoundCell = RangeFound(Range(Sh.Range("Q17"), Sh.Range("Q" & Sh.Rows.Count)))

If Not rngFoundCell Is Nothing Then
If Not rngFoundCell.Address = FirstAddress Then
Sh.Range("B1").Value = rngFoundCell.Value
End If
End If
End If
Application.EnableEvents = True
End If
End Sub

Private Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function[/vba] hope that helps,

Mark

[adamsm]

Thanks for the help GTO. And thanks for correction Aussiebear.