DynamicLastRow

[soidog]

Hello,
I've been searching a lot but can't find the answer.
There are a number of cells with text string "DATE" in column "A".
Under every "DATE" there are 0-5 rows with dates, followed by an empty row.
I want to copy the "DATE"-row and the following rows with dates (0-5), offset 11 columns, to column "T" (pls. see code).
Any help is much appreciated.
This is what I have so far:

Sub LastRow()


Dim c       As range
Dim FA      As String
Dim ws      As Worksheet
Dim LR      As Long


Application.ScreenUpdating = False
Set ws = ActiveSheet


With ws.Columns(1)
    Set c = Cells.Find(What:="DATE", LookAt:=xlWhole)
    FA = c.Address
    LR = range("A:A").CurrentRegion.Rows.Count  'Wrong?
    
    Do
        'range(c, c.Offset(5, 11)).Copy     'This works (static 5 rows)
        range(c, c.Offset(LR, 11)).Copy     'This works not. Rows can be 0-5, not only 5, until first empty row.


        range("T" & Rows.Count).End(xlUp).Offset(2).PasteSpecial


        Set c = .FindNext(c)
    Loop Until c Is Nothing Or c.Address = FA
End With
Application.ScreenUpdating = True
End Sub

/Tom

 

[Scott T]

Try change the 1 to whatever column you want to use to find the last row. 1=column A 2=Column B....

LR = Cells(Rows.Count, 1).End(xlUp).Row

 

[soidog]

Thank you Scott T but I'm sorry to say, that didn't do it. It copied everything + some extra empty rows, in the first loop.

 

[Jonmo1]

Is it

LR = Cells(Rows.Count, c.Column).End(xlUp).Row

 

[Scott T]

This seamed to worked for me

LR = Range(FA).End(xlDown).Row - 1

 

[soidog]

Thank you Jonmo1, but that solution did exactly the same as Scott T's first answer.


Scott T, you'r getting closer! But this solution acts almost the same as my "static" code: (range(c, c.Offset(5, 11)).Copy), to copy "DATE" cell plus 5 rows below "DATE". The number of copied rows is constant.


To test the code you can just write "DATE" in any cells in column "A".
Below "DATE" you write dates in 0 to 5 cells.
Below last date is an empty cell.
Let's say:
"A2"= "DATE"
"A3:A7"= 5 dates (fill in any dates).
"A8:L8"= empty cells
"A2:L7" shall be copied.


"A16"= "DATE"
"A17:A19"= 3 dates (fill in any dates).
"A20:L20"= empty cells
"A16:L19" shall be copied.


"A25"= "DATE"
"A26= 0 dates
"A26:L26"= empty cells
"A25:L25" shall be copied.


"DATE" (text cells) are dynamic in column "A".
Dates (number cells) below "DATE" are dynamic, and always between 0-5 cells.
It's always an empty cell below the last date.
/Tom

 

[Jonmo1]

Thank you Jonmo1, but that solution did exactly the same as Scott T's first answer.

No it didn't.

It may have coincidetally arrived at the same answer, but it did it in a very different way.

This hard codes column A (1) to search for the last occupied cell
LR = Cells(Rows.Count, 1).End(xlUp).Row

This 'dynamically' chooses the column based on where "DATE" is found
LR = Cells(Rows.Count, c.Column).End(xlUp).Row

c is the cell reference where DATE was found, so c.Column = that column number.

 

[Scott T]

Try

Sub LastRow()

Dim c       As Range
Dim FA      As String
Dim ws      As Worksheet
Dim LR      As Long

Application.ScreenUpdating = False
Set ws = ActiveSheet

With ws.Columns(1)
    Set c = Cells.Find(What:="DATE", LookAt:=xlWhole)
   
    
    Do
        FA = c.Address 'to reset LR this needs to run for each loop
        FArow = Mid(FA, 4, 999)
        LR = Range(FA).End(xlDown).Row - FArow
        If LR > 5 Then
            LR = 0
        End If
        'range(c, c.Offset(5, 11)).Copy     'This works (static 5 rows)
        Range(c, c.Offset(LR, 11)).Copy     'This works not. Rows can be 0-5, not only 5, until first empty row.

        Range("T" & Rows.Count).End(xlUp).Offset(2).PasteSpecial

        Set c = .FindNext(c)
    Loop Until c Is Nothing Or c.Address = FA
End With
Application.ScreenUpdating = True
End Sub

 

[soidog]

Thank you Jonmo1, I have noted your info.


Scott T, you'r almost there! I defined FArow as String and the code does exactly what I want, but the loop doesn't stop after last find "DATE"!
Also could you explain to me what this does: FArow = Mid(FA, 4, 999)?
Is this line: If LR > 5 Then... checking if there is more than 5 dates below "DATE"?
Thanks a lot/Tom

 

[Scott T]

Your original code was using the row number found by LR as the offset but this is not what you want. In your example in poste #6 the LR of the second "DATE" is 19. The would make your offset 19 rows so you are copying more rows then you want to. What you want the offset to be is the number of rows in that block. So for your second "DATE" you start in A16 and the offset want is what gets you the copy range A16:L19. So LR is

LR = Range(FA).End(xlDown).Row - FArow

The first part Range(FA).End(xlDown).Row returns row (19) the last part subtracts FA which is the row where "DATE" (the Mid(FA, 4, 999) extracts the row number from the string.) this give you the variable number of rows to offset.

I added the If LR > 5 Then because if there was a "DATE" with no dates like A25 in you example The code with out the if statement would have an offset of 1048576 (or how many the max rows in your version of Excel). Since 5 is the max valid LR value if it is greater the 5 then there is no offset and only the row with date should be copied.

The find next c was looping back to the first date so c was never nothing. Try

Sub LastRow()
Dim c       As Range
Dim FA      As String
Dim ws      As Worksheet
Dim LR      As Long
Dim counter As Long
Dim origc As Range
Application.ScreenUpdating = False
Set ws = ActiveSheet
With ws.Columns(1)
    
    Set c = Cells.Find(What:="DATE", LookAt:=xlWhole)
   Set origc = c
    
    Do
        counter = counter + 1
        FA = c.Address 'to reset LR this needs to run for each loop
        FArow = Mid(FA, 4, 999)
        LR = Range(FA).End(xlDown).Row - FArow
        If LR > 5 Then
            LR = 0
        End If
        'range(c, c.Offset(5, 11)).Copy     'This works (static 5 rows)
        Range(c, c.Offset(LR, 11)).Copy     'This works not. Rows can be 0-5, not only 5, until first empty row.
        Range("T" & Rows.Count).End(xlUp).Offset(2).PasteSpecial
        Set c = .FindNext(c)
    Loop Until counter > 0 And origc = c
End With
Application.ScreenUpdating = True
End Sub