CODEWITHSUNDEEP
excelvbaloops
Mike Y
Mike Y

Reputation: 5

Cut and Paste looping w/ VBA help needed

I'm hoping you can assist me with creating a VBA macro. I have a spreadsheet that has some formatting errors that I'm attempting to fix. I want to look for an empty range of cells (in the provided example, E6:H6). If the range is empty, I want to cut part of the data from the row directly below it (B7:E7) and paste it in E6.

Example Spreadsheet

enter image description here

I've got the code to do this, however I can't figure out how to loop the macro to continue looking for additional instances. Here's the VBA I have so far.

Sub Range_Cut()

Range("B7:E7").Cut Range("E6:H6")

End Sub

Any help would be greatly appreciated!!

Upvotes: 0

Views: 87

Answers (2)

Tim Williams
Tim Williams

Reputation: 166835

Untested:

Dim C As Range
For each c in activesheet.range("a2:a17").cells
    if len(c.value) = 0 then c.offset(0, 1).resize(1, 4).cut _
           c.offset(-1, 4)
next c

Upvotes: 0

Valon Miller
Valon Miller

Reputation: 1156

This is specific to your use case, but it should work. More effort could be applied to making the ranges fully qualified and dynamic.

Sub testLoop()

    Dim rng As Range
    Dim c As Range

    Set rng = Intersect(ActiveSheet.UsedRange, Range("E:E"))

    For Each c In rng

        If c.Value = "" And c.Offset(0, -1) <> "" Then
            c.Offset(1, -3).Resize(1, 4).Cut c
        End If

    Next c

    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

It goes through column E looking for blank cells where there is a value in D. when it finds one, it cuts the offset range from the row below and pastes it in E. Then at the end it deletes the empty rows.

Upvotes: 1

Related Questions