0

Really new to VBA, so forgive any stoopid things I say/do. This site has been a huge help in my accelerated learning so far.

I have a set of data in Excel that I need to rearrange using VBA. I want to take (cut) data from columns AF:AR for a row and move (paste) it to columns J:V in a new row inserted below the original one. The data set is a different size each time I run the report, so I am approaching it from the end of the data set and moving up through the spreadsheet. The data set has headers, so it stops at row 2. My plan so far is to move to the end of the data set, cut the data from the last row and paste it on the row below, insert a blank row above, then move up a row and repeat until row 2 is reached.

Here's what I have so far:

' Move to end of data.
Selection.End(xlDown).Select
' Repeat loop until top of data is reached..
Do Until ActiveCell.Row = 2
    ' Get row address of active cell.
    ActiveRow = ActiveCell.Row
    ' Cut and paste data to row below current row.
    Range(Cells(ActiveRow, "AF"), Cells(ActiveRow, "AR")).Cut Range("J" & ActiveRow).Offset(1, 0)
    ' Insert a blank row above.
    ActiveCell.Offset(-1, 0).Select
    ActiveCell.EntireRow.Insert Shift:=xlDown
    ' Move to next row of data up.
    ActiveCell.Offset(-1, 0).Select
Loop

When running, I get this error

"Run-time error '1004': Application-defined or object-defined error."

and debug points me to the following line:

Range(Cells(ActiveRow, "AF"), Cells(ActiveRow, "AR")).Cut Range("J" & ActiveRow).Offset(1, 0)

I can't find any info on using the dynamic range with offset in the .Cut function, so this may be the problem. Is there something wrong/missing from my syntax or is there a simpler way to accomplish my goal?

Thanks in advance for sharing your genius.

jeepinozz
  • 1
  • 2
  • 1
    There's nothing syntactically wrong with that line. What exactly is "the problem"? Also you should read this before going any further https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – SJR Oct 25 '19 at 14:00
  • Your question refers to J-V but your code uses A? – SJR Oct 25 '19 at 14:01
  • SJR, I added the error text and changed the code to paste directly into J rather than offsetting the 9 cells to the right from A...but the problem persists. – jeepinozz Oct 25 '19 at 14:16
  • What is the value of `ActiveRow`? – SJR Oct 25 '19 at 14:17
  • ActiveRow = 1048576, but is assigned the row address of the active cell when the loop begins – jeepinozz Oct 25 '19 at 14:24
  • 1
    As I thought, that is the bottom row of the spreadsheet and you are trying to go one row down, which is clearly impossible. Your problem initially arises from using Select so read that article I linked to first. I can't quite visualise what you are trying to do so can't offer a precise answer but you need to refine the block of data you are working with. – SJR Oct 25 '19 at 14:26
  • If your dataset contains less than 1M rows, you can find the last non-empty cell in column AF this way: `lastrow = Range("AF1000000").End(xlUp).Row`. So init your `ActiveRow` this way and your logic will work. And right after making it work you' better rework the code to eliminate all selects and activecell references. – AcsErno Oct 25 '19 at 15:28
  • Ah...I see. I could put an additional offset in ahead of the loop to move up 1 row from the bottom., but it would take forever to cut/paste 1M+ lines of blank cells. I'll look at rewriting using a range variable and CurrentRegion to define the size. That should take me a while, but I'll learn something in the process. – jeepinozz Oct 25 '19 at 15:29

1 Answers1

0

This is a little cleaner and much faster, but still has the select and activate thorns. I may go back and work on it down the road, but it works for now.

'Define the range of remaining data.
Set rngData = ThisWorkbook.Worksheets("Sheet2").Range("A1")
Set rngData = rngData.CurrentRegion

' Move to end of data.
rngData.End(xlDown).Select
Do Until ActiveCell.Row = 1
    ' Get row address of active cell.
    ActiveRow = ActiveCell.Row
    ' Cut and paste OCC data to row below current row.
    Range(Cells(ActiveRow, "AF"), Cells(ActiveRow, "AR")).Cut Range("J" & (ActiveRow + 1))
    ' Insert a blank row above.
    ActiveCell.EntireRow.Insert Shift:=xlDown
    Selection.Offset(-1, 0).Select
' Repeat until top of data is reached.
Loop

' Delete unnecessary remaining column headers.
ThisWorkbook.Worksheets("Sheet2").Range("AF1:AR1").Clear

' Delete Unnecessary blank row #2.
Range("A2").EntireRow.Delete
jeepinozz
  • 1
  • 2