vba, loop,

[bahllr]

I have written the below code (as part of a larger code set) to copy a range and paste it in cell Z4 if Z4 is empty. If it isn't empty, I want it to move one cell to the right and paste it in AA4. This should be a loop pasting one cell to the right of the last filled cell.

I have come up with the following which moves one cell to the right, but only once. It doesn't loop. Also, this loop operates within a larger loop....is there anything I must consider for it to be successful?

Can you help me accomplish what I am trying to do?

Range("z4").Select
If Range("z4") = "" Then
ActiveSheet.Paste
Application.CutCopyMode = False
Else

i = 1
Range("z4").Offset(0, i).Select
i = i + 1

ActiveSheet.Paste
Application.CutCopyMode = False
End If

 

[lenze]

Sub PasteMe()
Dim i As Long
i = 26
Redo:
If Cells(4, i) = "" Then
   Cells(1, 1).Copy Cells(4, i)
   Exit Sub
Else
   i = i + 1
   GoTo Redo
End If
End Sub

Change the Cells(1,1) to the Range you want to copy
lenze

 

[dscg]

Do you just need row 4, and how far to the right will it need to loop?

Is there a case where Z4 will have something, it looks to paste in AA4, but AA4 might have something already? Would you skip over AA4 in this case or overwrite it?

 

[Oaktree]

FWIW, if you're pasting to the rightmost cell in row 4, you could use:

Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1) = Cells(1,1)

and skip the looping all together.

 

[bahllr]

thank you for the responses. As clarification:

1. the code before this section I am trying to fix copies a range
2. I want it pasted in cell Z4 (this is the first place something will be pasted)
3. loop operation, reselect a range to be copied
4. paste in the cell to the right of z4
5 continue to loop and move one cell right of the last filled cell in the 4th row

There will never be filled cells in the 4th row from column z on.

There will be at most, 100 loops possible here

Hope that helps explain what I am trying to do.

Thanks.

 

[lenze]

So, what range are you copying??

lenze

 

[bahllr]

Sorry. I am copying a dynamic sized range starting at B23. I use the following code to sort it for unique values before copying it.

Range("B23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("B23"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range(Selection, Selection.End(xlDown)).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Selection.Copy

 

[lenze]

Range(Selection, Selection.End(xlDown)).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
'Selection.Copy  <!-- / message -->
Dim i As Long
i = 26
Redo:
If Cells(4, i) = "" Then
   Selection.Copy Cells(4, i)
   Exit Sub
Else
   i = i + 1
   GoTo Redo
End if

lenze

 

[bahllr]

Thanks everyone for your help! I think between everyones input, I have figured out how to put it together.

 

[lenze]

You could use Oaktree's idea

Range(Selection, Selection.End(xlDown)).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Selection.Copy  Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1)

No loop

lenze<!-- / message -->