"Object not found", move two excel cells diagonally

Question

I have an excel sheet like so:

| A----| B-------| C----| D-------|
| Todd | Sentry  |
| Gary | Alquist |

I want a VBA script that essentially moves the second row diagonally like so:

| A----| B-------| C----| D-------|
| Todd | Sentry  | Gary | Alquist |

And I want it to do this for every occurrence there are two rows stacked on top of each other with content, moving the second row diagonally beside the first.

But I keep getting an Object not found error in the For loop.

Sub Macro1()
    ' Macro1 Macro
    ColOne = "A"
    ColTwo = "B"
    ColThree = "C"

    For Index = 1 To 1000
        Below = Index + 1
        If IsEmpty(ColOne + Index.ToString + ":" + ColTwo + Index.ToString) Then
        Else
            Range(ColOne + Below.ToString + ":" + ColTwo + Below.ToString).Select
            Selection.Cut
            Range(ColThree + Index.ToString).Select
            ActiveSheet.Paste
            Index = Index + 2
        End If
    Next
End Sub

That's some useless sample data. Add more rows to the before and the after. Also, clarify if the result replaces the source or if it should be copied to another location. Here is an interesting formula for the latter case (if there are no empty rows): `=WRAPROWS(TOCOL(A2:A5),4,"")`. — VBasic2008, Jun 09 '23 at 07:41

Siddharth Rout · Answer 1 · 2023-06-09T06:12:27.637

I keep getting an "Object not found" error in the for loop:

You are getting an error because of the line

If IsEmpty(ColOne + Index.ToString + ":" + ColTwo + Index.ToString)

I believe you want to check if the range is empty?

Also few other things...

Index is a ReadOnly property. Use another variable.
ToString is in VB.Net. Not in VBA.
For string concatenation use & and not +.
Avoid the use of .Select/.ActiveSheet etc.. Work with Objects.

Is this what you are trying?

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long
    Dim aCell As Range
    
    '~~> Change this to the relevant worksheet
    Set ws = Sheet1

    For i = 1 To 1000
        '~~> This the range that you want to work with
        Set aCell = ws.Range("A" & i & ":B" & i)
        
        '~~> Check if the range is not empty
        If Application.WorksheetFunction.CountA(aCell) <> 0 Then
            '~~> Cut and paste at the same time
            aCell.Offset(1).Cut Destination:=ws.Range("C" & i)
            i = i + 1
        End If
    Next
End Sub

Screenshot

Before

After

PS: If you do not want to hardcode 1000 in the above loop then you can find the last row and use that as show HERE

"Object not found", move two excel cells diagonally

1 Answers1