VBA loop code Error help!

[erimhast83]

I am running the below code and getting an error at the end when the do untilempty is not working and the code runs until the third line and there are no more rows in the spreadsheet since column G had no data in any cells. Can someone please help me figure out the error in my coding. Thank you.



Do Until IsEmpty("D2:D")


Range("G2").End(xlDown).Select
ActiveCell.Offset(1, -3).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight).Offset(0, 3)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(-1, 3).Select
Selection.Cut
ActiveCell.Offset(1, -1).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, -1& - 1).Select
Range(Selection, Selection.End(xlToRight).Offset(0, -1)).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Loop

 

[MARK858]

I'll post something when I get in (just don't want to make a typo on my phone). What do you want to base the last row variable on?

 

[erimhast83]

I'll post something when I get in (just don't want to make a typo on my phone). What do you want to base the last row variable on?

I would like the last row to be based on the last cell with data in the column D. My data will change monthly and i don't want to be tied to a set row number.

 

[MARK858]

Not tested but can you run the below on a copy of your data and let me know what happens please.
I suspect we will need to loop upwards and so be prepared to break the sub.

Sub test1()
Dim myCell As Range
For Each myCell In Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
If myCell.Value <> "" Then
myCell.Offset(, 3).End(xlDown).Select
ActiveCell.Offset(1, -3).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight).Offset(0, 3)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(-1, 3).Select
Selection.Cut
ActiveCell.Offset(1, -1).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, -1& - 1).Select
Range(Selection, Selection.End(xlToRight).Offset(0, -1)).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next

End Sub

 

[erimhast83]

Thank you for your help! I am getting a compile error: Next without for when i try to run the code you sent.

Not tested but can you run the below on a copy of your data and let me know what happens please.
I suspect we will need to loop upwards and so be prepared to break the sub.

Sub test1()
Dim myCell As Range
For Each myCell In Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
If myCell.Value <> "" Then
myCell.Offset(, 3).End(xlDown).Select
ActiveCell.Offset(1, -3).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight).Offset(0, 3)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(-1, 3).Select
Selection.Cut
ActiveCell.Offset(1, -1).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, -1& - 1).Select
Range(Selection, Selection.End(xlToRight).Offset(0, -1)).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste

Next

End Sub

 

[MARK858]

Put

End If

above the Next line

 

[erimhast83]

I am getting a debug error because it is still going to the last row in the spreadsheet. I want to try and get it to stop the loop if there is no data in the cell in column D.

Put

End If

above the Next line

 

[MARK858]

That's why I said we will probably have to loop backwards because you are inserting lines.
I will have to do some tests with the code you have recorded (I do hate recorded code ) but I probably won't get round to it until the weekend.