VBA, moving some range down, if not matching time

99 views Asked by At

I have 16k rows of data. There are two columns with time. What i need is to find rows where time doesn't match and move everyhing below in last 3 columns down on one, so at the end I'll have all rows with time match and those that dont would have last 3 columns blank in that row. here what I have so far, but I'm new to VBA and this doesnt work(

Sub timeline()

Dim y As Long
    With ThisWorkbook.Sheets("L5")
    y = .Range("G" & .Rows.Count).End(xlUp).Row
    End With

x = 2
Do While ThisWorkbook.Sheets("L5").Cells(x, 4) <> ""


    If ThisWorkbook.Sheets("L5").Cells(x, 4).Value = ThisWorkbook.Sheets("L5").Cells(x, 7).Value Then

    Else: ThisWorkbook.Sheets("L5").Range("Gx:Iy").Select
    Selection.Offset(1, 0).Select

    y = y + 1

    End If

x = x + 1
Loop
1

There are 1 answers

1
Paul Ogilvie On BEST ANSWER

The following code should do it. Check whether the right ranges and cells are used; I tried to figure it out from your code:

Sub timeline()

    Dim y As Long
    With ThisWorkbook.Sheets("L5")
        y = .Range("G" & .Rows.Count).End(xlUp).Row
    End With

    x = 2
    Do While ThisWorkbook.Sheets("L5").Cells(x, 4) <> ""

        If ThisWorkbook.Sheets("L5").Cells(x, 4).Value = ThisWorkbook.Sheets("L5").Cells(x, 7).Value Then
            ' nothing
        Else
            ThisWorkbook.Sheets("L5").Range("G" & Trim(Str(x)) & ":I" & Trim(Str(y))).Cut
            ThisWorkbook.Sheets("L5").Range("G" & Trim(Str(x + 1))).Select
            ThisWorkbook.Sheets("L5").Paste
            y = y + 1
        End If

        x = x + 1
    Loop
End Sub