Stopping VBA code when it hits the last row

[Guest]

I have a list of data the is in 4 columns, and the number of rows will vary
from week to week.. Columns A-C are filled with data, and Column D will only
have data in certain cells (ie, row 6 could have a value and then the next
row to have a value could be row 20...and this value may or may not be
different than the value in row 6). I am trying to wrote code that will fill
in the blanks in column D, so it would copy the value in row 6 to all blank
cells below it until is finds another value (7-19 in my example). Then it
will find the next value and copy that to all blank rows below it, and so on
until all cells are filled. It's working fine except that the length of the
report varies from week to week, so my code will error out when it comes to
the bottom of the worksheet. Is there a way to write code to check for the
cell reference, and then stop if it = a certain cell? (D65536 for example)

My code:
Range("D2").Select
Selection.Copy

' FIND END OF THE RANGE
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate

' MOVE END OF RANGE UP ONE CELL AND SELECT ENTIRE RANGE
Range(Selection, Selection.End(xlDown).Offset(-1, 0)).Select

' PASTE TO ENTIRE RANGE
ActiveSheet.Paste

' FIND END OF THE RANGE
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate

' SELECT NEXT CELL TO COPY
ActiveCell.Offset(-1, 0).Range("A1").Select
Selection.Copy

 

[Don Guillett]

one way

Sub fillincolumn()
lr = Cells(Rows.Count, "a").End(xlUp).Row
For Each c In Range("a1:a" & lr)
If c = "" Then c.Value = c.Offset(-1)
Next
End Sub

 

[Bob Phillips]

Try this alternative

Public Sub test()
Dim iLastRow As Long
Dim i As Long
Dim iStartRow As Long
Dim iEndRow As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
i = 1
Do While Cells(i, "D").Value = ""
i = 1 + 1
Loop
Do
iStartRow = i
Do
i = i + 1
Loop Until Cells(i, "D").Value <> "" Or i > iLastRow
iEndRow = i
If iEndRow - iStartRow > 1 Then
Cells(iStartRow, "D").AutoFill Cells(iStartRow,
"D").Resize(iEndRow - iStartRow)
End If
Loop Until i > iLastRow

End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

 

[Guest]

I'm not sure I understand. What part of your code do I need to change to work
in my spreadsheet? The range I'm working with starts at 'D2' and goes down
column D (the end row varies each week).

 

[Guest]

What part of your code do I change to work with my spreadsheet? My range
starts in 'D2' and goes down column D. The ending row varies each week.

 

[Don Guillett]

You could ? try changing the A references to D

 

[Guest]

That worked, but there is one last problem. I forgot to mention that the
ending cell in my range is blank, so your code works except for the last
range I need to copy. For example, I need to copy 'D3070' and paste it down
to the end of my range which is 'D3117'. The column is blank from D3071 on
down. The last row of data in columns A-C is 3117. So what I need is for
the code to copy what is now the last ceel with data in column D, find the
ending row of data in columns A-C, and use that row as the end of the range
to paste in column D. does that make sense? Your code works great except
for the last range that needs to be pasted.

 

[Bob Phillips]

It should be okay as is.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)