empty cell / copy and paste

  • Thread starter Thread starter Helmut
  • Start date Start date
H

Helmut

From Active cell say "A15" determine if "D16" is 'empty'.
If yes THEN
copy "A:B15" to "A:B16" AND "G:H15" to "G:H16"
THEN Loop until next row empty
If no ELSE
do something else (not sure yet what)

I'm stuck on doing the first few lines.
Thanks
 
dim cell as range

'try
set cell = selection
'or
set cell = Range("A15")

do while cell.Value<>""

IF cells( cell.Row + 1, "D")="" THEN
Range( cells( cell.Row , "A"), cells( cell.Row , "B")).Copy
Range( cells( cell.Row+1 , "A"), cells( cell.Row+1 ,
"B"))..PasteSpecial = xlPasteAll
Range( cells( cell.Row , "G"), cells( cell.Row , "H")).Copy
Range( cells( cell.Row+1 , "G"), cells( cell.Row+1 ,
"H"))..PasteSpecial = xlPasteAll
End If

set cell = cell.Offset(1)
LOOP
 
Helmut said:
From Active cell say "A15" determine if "D16" is 'empty'.
If yes THEN
copy "A:B15" to "A:B16" AND "G:H15" to "G:H16"
THEN Loop until next row empty
If no ELSE
do something else (not sure yet what)

I'm stuck on doing the first few lines.
Thanks
Click to expand...


Helmut,

not sure what you want... What do you mean by A:B15? A15:B15?
Maybe this gives you a start:

If Len(Range("D16").Value)=0 then
Range("A16:B16").Value = Range("A15:B15").Value
Range("G16:H16").Value = Range("G15:H15").Value
End If


Regards,
xlDominik.
 
i use .Value mostly as i think its usually whats required. However, it was
pointed out to me that as its a table, its quite likely that the cells
contain formulae as well as values and format...hence my COPY
but I agree with VALUE if thats no issue
 
When I run the following, it executes ONCE, copying A15:B15 to A16:B16 but
DOES NOT execute the "Set cell = cell.Offset(1)" and therefore not the Loop
and I get an Error: "Object missing 424"

Sub order()

' check if new items are added and copy formulas

Range("B8").Select
Selection.End(xlDown).Select


Dim cell As Range

Set cell = Selection

Do While cell.Value <> ""

If Cells(cell.Row + 1, "D") = "" Then
Range(Cells(cell.Row, "A"), Cells(cell.Row, "B")).Copy
Range(Cells(cell.Row + 1, "A"), Cells(cell.Row + 1, "B")).PasteSpecial =
xlPasteAll
Range(Cells(cell.Row, "G"), Cells(cell.Row, "H")).Copy
Range(Cells(cell.Row + 1, "G"), Cells(cell.Row + 1, "H")).PasteSpecial =
xlPasteAll
End If

Set cell = cell.Offset(1)

Loop

' put value in lastrwo +1
Range("B8").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 3).Range("A1").Select
ActiveCell.FormulaR1C1 = "1"

'delete rows where cell in column E is empty

Dim i, j As Integer

Set starta = ActiveSheet.Range("E1")
lr = ActiveSheet.Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Row

For i = lr To 0 Step -1
If starta.Offset(i, 0).Value = 0 Then starta.Offset(i,
0).EntireRow.delete
Next i

' Delete last two rows with invalid information
Range("E8").Select
Selection.End(xlDown).Select
Selection.EntireRow.delete

End Sub



Everything else works ok.
Thanks if you can get me the Error fixed.
Helmut
 
Range("B8").Select
Selection.End(xlDown).Select
Click to expand...
you've selected the bottom cell in the column
the next cell down is selected by
Range("B8").Select
Selection.End(xlDown).Select
Click to expand...

at the end of the loop you move down
Set cell = cell.Offset(1)
Click to expand...
so of course its empty

try moving UP the list, change to
Set cell = cell.Offset(-1)
 
excuse typo - sorry

you've selected the bottom cell in the column
Range("B8").Select
Selection.End(xlDown).Select

at the end of the loop you move "down"
Set cell = cell.Offset(1)
so of course its empty

try moving UP the list, change to
Set cell = cell.Offset(-1)
 
Patrick,
The problem is during execution of this:

If Cells(cell.Row + 1, "D") = "" Then
Range(Cells(cell.Row, "A"), Cells(cell.Row, "B")).Copy
Range(Cells(cell.Row + 1, "A"), Cells(cell.Row + 1, "B")).PasteSpecial =
xlPasteAll
=====
here I get "Error 424 - Object Missing
=====
Range(Cells(cell.Row, "G"), Cells(cell.Row, "H")).Copy
Range(Cells(cell.Row + 1, "G"), Cells(cell.Row + 1, "H")).PasteSpecial =
xlPasteAll
End If
 
Back
Top