Copy Up until Non-Blank Cell encountered

[Jim May]

I need a procedure that will start with say cell L300 (which has a text
value) and
Copy it into cells L299-L250 that are blank; L249 has a different Cell value
and I need to copy it into cells L248-L150 that are blank, etc until Row 2.
How would I do that? Do while.. Loop but I can't solve...
Any help appreciated

 

[Don Guillett]

Sub fillinblanks()
mycol = "L"
For i = Cells(Rows.Count, mycol).End(xlUp).Row To 2 Step -1
If Cells(i - 1, mycol) = "" Then
Cells(i - 1, mycol).Value = Cells(i, mycol)
End If
Next i
End Sub

 

[Jim Thomlinson]

Assuming the cells are truely blank (not formulas returning blank or such)
then this should do it...

Sub CopyLotsOfStuff()
Call CopyStuff(Range("L300"))
Call CopyStuff(Range("L249"))

End Sub

Sub CopyStuff(ByVal rngToCopy As Range)
Dim rngToPaste As Range

Set rngToPaste = rngToCopy.Offset(-50, _
0).Resize(49).SpecialCells(xlCellTypeBlanks)

rngToPaste.Value = rngToCopy.Value
End Sub

 

[Jim May]

I Have:
within Sub FindlRow:
....
Lrow = Cells(i, 1).Row
Exit For
End If
Next i
End With
ActiveSheet.Range("A2:G" & Lrow).Copy
Sheets("Main").Range("A2").PasteSpecial Paste:=xlValues
CutCopyMode = False
With Sheets("Main")
.Activate
.Calculate
.Range("I2").Select
End With
With Sheets("Filter")
.Range("A2:M5000").ClearContents
End With
ActiveSheet.Range("I2:T" & Lrow).Copy
Sheets("Filter").Range("A2").PasteSpecial Paste:=xlValues
CutCopyMode = False
Sheets("Filter").Activate
Range("b2").Select
Call CopyGrpUp <<< See below
End Sub

Sub CopyGrpUp() ' Your code modified...
mycol = "T"
For j = Cells(Lrow, mycol).End(xlUp).Row To 2 Step -1 " R/t 1004 Occurs
here !!
If Cells(j - 1, mycol) = "" Then
Cells(j - 1, mycol).Value = Cells(j, mycol)
End If
Next j
End Sub

But when I run I get R/T 1004 Lrow

 

[Jim May]

Never Mind Don,, I worked it out.. Thanks for the help
Jim

 

[Don Guillett]

Your problem appears? to be at the start with "within". What are you trying
to do??? What I sent was intended to determine the last row in column
T...... and fill in the blanks in col T from the bottom up, as requested.
What comes before that needs a re-think.

 

[Don Guillett]

Some cleaning up perhaps. Could even be better using with for sheets("main")

Have:
within Sub FindlRow:
....
Lrow = Cells(i, 1).Row
Exit For
End If
Next i
End With
'dont understand above to get Lrow?
ActiveSheet.Range("A2:G" & Lrow).Copy
Sheets("Main").Range("A2").PasteSpecial Paste:=xlValues
Sheets("Main").Calculate
Sheets("Filter").Range("A2:M5000").ClearContents
sheets("main").Range("I2:T" & Lrow).Copy
Sheets("Filter").Range("A2").PasteSpecial Paste:=xlValues

Sheets("Filter").Activate
Call CopyGrpUp
End Sub

Sub CopyGrpUp()
mycol = "T"
For j = Cells(rows.count, mycol).End(xlUp).Row To 2 Step -1
If Cells(j - 1, mycol) = "" Then
Cells(j - 1, mycol).Value = Cells(j, mycol)
End If
next j
End Sub