mistybev
mistybev

Reputation: 1

VBA code for moving a row based on criteria

I am new to StackExchange and VBA and I have tried to find an answer to this but I'm having issues!!!

I have a spreadsheet where information is input and appears in Sheet 2, columns B-I. What I would like it to do is that if Column H is blank, it moves the whole row into column L to S. So my data will be split into 2 separate places on the same sheet based on whether H is empty or populated.

The information in column H will be different every time so i can't specify what will be in the column, but there are times when there will be nothing input into column H and that is when I want it to move.

Can anyone tell me how to achieve this? Many thanks Bev

Upvotes: 0

Views: 925

Answers (2)

Davesexcel
Davesexcel

Reputation: 6984

Move the blanks,

Sub MoveBlanks()
    Dim lRws As Long, sh As Worksheet, x

    Set sh = Sheets("Sheet2")

    With sh
        lRws = .Cells(.Rows.Count, "B").End(xlUp).Row
        For x = lRws To 2 Step -1
            If .Cells(x, "H") = "" Then
                .Range(.Cells(x, "B"), .Cells(x, "I")).Cut .Cells(.Rows.Count, "L").End(xlUp).Offset(1)
                .Range(.Cells(x, "B"), .Cells(x, "I")).Delete Shift:=xlUp
            End If
        Next x
    End With

End Sub

Before

enter image description here

After enter image description here

Upvotes: 1

user1582568
user1582568

Reputation: 288

Try this for a starting point

Option Explicit
Const FIRST_ROW As Long = 2
Const LAST_ROW As Long = 100
Const FIRST_SOURCE_COL As Long = 2 'column B
Const LAST_SOURCE_COL As Long = 9 'column I
Const TRIG_COL As Long = 8 'column H
Const GAP As Long = 2 'columns gap between original data and moved data

Sub moveit()
Dim r As Long
Dim c As Long
Const DIST As Long = LAST_SOURCE_COL - FIRST_SOURCE_COL + GAP + 1

For r = FIRST_ROW To LAST_ROW
    'check if we need to move
    If Cells(r, TRIG_COL).Value = "" Then
    'move the data
        For c = FIRST_SOURCE_COL To LAST_SOURCE_COL
            Cells(r, c + DIST).Value = Cells(r, c).Value
            Cells(r, c).Value = ""
        Next
    End If
Next
End Sub

Upvotes: 1

Related Questions