Repeat copy

Topic

New Reply

Can anyone advise me on how I can repeat a copy based on locating the next blank cell in a column.
I currently use some code based around Ctrl+down and starting in cell “R2C5″ to locate cell before blank, copy that cell contents down to the blank cell find next blank etc.etc.

Application.Goto Reference:=”R2C5”
Selection.End(xlDown).Select

Selection.End(xlDown).Select
Selection.Copy
Range(“E7”).Select
ActiveSheet.Paste
Application.CutCopyMode = False

I am not very confident in setting variables and creating loops until done

Reply | Quote

Replies

bonriki

Try this for a one-time paste:

Code:

Public Sub CopyBlock()
Cells(ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row, 5).Select[COLOR=”#008000″] ‘FIND LAST ROW[/COLOR]
Cells(ActiveSheet.Cells(ActiveCell.Row, 5).End(xlUp).Row, 5).Select [COLOR=”#008000″]’FIND PREVIOUS[/COLOR]
AvailableRow = ActiveCell.End(xlDown).Row
Range(Cells(ActiveCell.Row, 5), Cells(AvailableRow, 5)).Select [COLOR=”#008000″]’SELECT RANGE[/COLOR]
Selection.Copy
Cells(AvailableRow + 1, 5).Select [COLOR=”#008000″]’SELECT NEXT AVAILABLE ROW[/COLOR]
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

If you re-run the code, it will copy both consecutive blocks and paste with a result of a total of 4 blocks.

If you want to repeatedly paste the same data (one block) at the next blank then use this code:

Code:

Public Sub RepeatCopy()
Cells(ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row, 5).Select [COLOR=”#008000″] ‘FIND LAST ROW[/COLOR]
If Application.CutCopyMode = 1 Then GoTo Skip[COLOR=”#008000″] ‘IF THERE IS COPIED DATA ON CLIP BOARD[/COLOR]
Cells(ActiveSheet.Cells(ActiveCell.Row, 5).End(xlUp).Row, 5).Select [COLOR=”#008000″]’FIND PREVIOUS[/COLOR]
AvailableRow = ActiveCell.End(xlDown).Row
Range(Cells(ActiveCell.Row, 5), Cells(AvailableRow, 5)).Select [COLOR=”#008000″]’SELECT RANGE[/COLOR]
Selection.Copy
Cells(AvailableRow + 1, 5).Select [COLOR=”#008000″]’SELECT NEXT AVAILABLE ROW[/COLOR]
Skip:
ActiveSheet.Paste
End Sub

Reply | Quote

Maud hi
Not quite what I wanted
In column E(5) starting at E3, seek next empty cell, move up 1 row, copy, move down 1 row, paste. Repeat until no more

Reply | Quote

Fill in the blank cells with the value above it? if so, then here you go.

Code:

Public Sub CopyRow()
LastRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row + 1
[e2].Select
Repeat:
AvailableRow = ActiveCell.End(xlDown).Row
Cells(AvailableRow, 5).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
If ActiveCell.Row = LastRow Then Exit Sub
GoTo Repeat
End Sub

Reply | Quote

Thanks again Maude
This works for all but the last block.

The code fails at this line; “ActiveCell.Offset(1, 0).Select”, and leaves the cursor in the very last cell in that column flashing and waiting for a command.

mmmmm a bit puzzling

Reply | Quote

That just means you have the cell copied to the clipboard to dotted lines enter the code:
Application.CutCopyMode=False

Which gets you out of Copy Mode

Steve

Reply | Quote

Steve thanks for that
It’s not the being in clipboard copy mode that’s the problem. The code should have moved down to the next empty cell in the column. Excel, as usual, moves right to the end and then back up to the cell below the next with data but this is not happening and the code stalls waiting to move to the next cell down

Reply | Quote

Are you looking for somethin like:

Code:

Option Explicit
Public Sub CopyBlock()
  Dim lLastRow As Long
  lLastRow = Cells(Rows.Count, 5).End(xlUp).Row
  Range("E2:E" & lLastRow).Copy Range("E" & lLastRow + 1)
End Sub

Steve

Reply | Quote

Steve
Not really. We data exported from our CRM as per:
35464-ExtraProg

What is required is to copy the last cell with the prog code in “E” down to the next blank cell in “E”. Works fine for all except the last where the code goes to the last cell in column “E” and then tries to paste to the next cell down!
I have tried all sorts of ways to get the code to check whether it is in the last cell of the column but to no avail.

Reply | Quote

Are you trying to fill all the blank rows?You don’t need code for that.
Select Column E
Find & Select – Goto Special…
Select “Blanks” [ok]
in E2 enter:
=E1
confirm with ctrl-enter
Select column E
Copy
Paste special -values

If that is not what you want could you attach an example sheet with a before and after?
Steve
PS. The code for the filling in the blanks would be:

Code:

Sub FillBlanks()
  Columns("E:E").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
  Columns("E:E").Copy
  Range("E1").PasteSpecial Paste:=xlPasteValues
  Application.CutCopyMode = False
End Sub

Reply | Quote

The code fails at this line; “ActiveCell.Offset(1, 0).Select”, and leaves the cursor in the very last cell in that column flashing and waiting for a command.

Bonriki,

If the code fails at any line, it will not be waiting for any commands. It is in debug mode.

What is required is to copy the last cell with the prog code in “E” down to the next blank cell in “E”.
Works fine for all except the last where the code goes to the last cell in column “E” and then tries to paste to the next cell down!

I can’t tell the difference of what you are saying what the code is supposed to do, what your description of the problem is, and what the code actually does. They all seem the same. Using the Values in column E, it takes the last E (Third E from the bottom), which happens to be in row 31. Copies it and puts it in row 32. That is what the code has been doing for each blank cell. It copies the cell value above it and pastes it in the blank cell

seek next empty cell, move up 1 row, copy, move down 1 row, paste. Repeat until no more.

Line 31 = “E”, copy it, paste it into blank cell 32 which is now the last cell in the column

35470-CopyBlock4 35471-CopyBlock5

Reply | Quote

Maud
Still can’t seem to get the code to work. Attached is a stripped down version of the s/sheet.
If you run TotalBlocks first and then the ExtraProgCode module the problem manifests itself

Reply | Quote

How about:

Code:

Option Explicit
Public Sub FillSomeBlanks()
  Dim lLastRow As Long
  Dim lRow As Long
  lLastRow = Cells(Rows.Count, 5).End(xlUp).Row + 1
  For lRow = 3 To lLastRow
   If Cells(lRow, 5) = "" And Cells(lRow, 2) = "" Then
    Cells(lRow, 5) = Cells(lRow - 1, 5)
  End If
  Next
End Sub

Steve

Reply | Quote

Do you actually need a 2nd routine? Why not simply add the line:
Cells(availablerow, 5) = Cells(availablerow – 1, 5)

right before you have the line
Cells(availablerow, 20) = “Subtotal:”

In your TotalBlocks code and do it all at once…

Steve

Reply | Quote

Steve
Thanks for that.
It works just fine with that line of code added

Reply | Quote

Bonriki

So now I see where the problem is. You are first running a code that places additional blank cells. A very important piece of information left out. The snippet is called from your TotalBlocks subroutine (last line).

This fixes it with the extra spaces:

35477-copy3

Code:

Public Sub CopyRow()
LastRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row + 1
[e2].Select
Repeat:
AvailableRow = ActiveCell.End(xlDown).Row
Cells(AvailableRow, 5).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(2, 0).Select
If ActiveCell.Row >= LastRow Then Exit Sub
GoTo Repeat
End Sub

Reply | Quote

Maud
Nearly there. Unfortunately there are several blocks that do not get the extra row code applied. This only shows up when the data in the full spreadsheet is treated.
It seems to be quite random; first block @ line7, 4th block (1 entry)@ line 58, 5th block @ line 63, 12th block (1 entry) @ line 281, 15th block (1 entry) @ Line 298, 18th block (1 entry) @ line 311, 22nd block (1 entry) @ line334, 23rd block (3 entries) @ line339.

I would like to send you the full file, its not very big, but it is quite confidential

Reply | Quote