Cut particular rows, based on criteria in 1 cell, and insert below existing data

[zookeepertx]

Hello all!

I've been struggling with this all day and am surrendering!

I need to run through a table of data where column E will contain either A or O. Any row that has O in column E needs to be cut and moved down below the rest of the data. The code I have is sort of working but it has a few glitches that I'm hoping you can help me with. The data is grouped by "Country Code" in column A.
If a country only has 1 row and that row has O in column E, the "O row" AND the Total row below it needs to be cut and inserted 5 rows below the last row of data.
If a country has more than 1 row and all rows have O in column E, all of the rows AND the Total row below the group needs to be cut and inserted 5 rows below the last row of data.
If a country has more than 1 row that has O in column E, that row needs to be cut and inserted 2 rows below and row that was already moved down there.

I'll put the code for that part of the macro below. (The code immediately following that fixes the section of rows with O so that each group has a Total row, so that part is okay.)
My theory so far was to have the macro start at the last row and go up, cutting rows as needed and inserting below, but it isn't working completely consistently.

For i = lr To 5 Step -1
lr3 = Application.WorksheetFunction.Match("O",Range("E" & i+1 ":E" & Range("E" & Rows.Count).End(xlUp).Row),0)

    If Range("E" & i).Value = "O" Then
        If Range("E" & i + 1) = "Total" Then
            If Range("E" & i - 1) = "Total" Then
                Rows(i & ":" & i + 1).Cut
                Rows(lr3).Insert Shift:=xlDown
            Else
            Rows(i).Cut
            Rows(lr3).Insert Shift:=xlDown
            Range("C" & lr).Value = "Total"
            End If
        Else
        Rows(i).Cut
        Rows(lr3).Insert Shift:=xlDown
        Range("C" & lr).Value = "Total"
        End If
   
    End If
Next i

Right now, it's unhappy with this row:

lr3 = Application.WorksheetFunction.Match("O",Range("E" & i+1 ":E" & Range("E" & Rows.Count).End(xlUp).Row),0)

With that line I was thinking to have it find the first row with O that's been moved down and use that to determine where to insert the next row, but I can't seem to get it right. I'm sure there's a better way to do this than what I was trying to accomplish, so feel free to ignore my code and do it a better way, LOL!

I'm on my work computer and am not allowed to download anything on it so am unable to attach a workbook, but will add pictures below. Naturally, the first sheet is what I start out with and the second sheet is the hoped for result.

I will greatly appreciate any help anyone can give me!

Jenny

 

[zookeepertx]

Well, it took most of today, but I approached this from a different angle and finally got it to do what I wanted. WHEW! I'm sure it isn't the cleanest or the fastest way, but it works, so far.

 

[jolivanes]

Range("E" & i + 1 & ":E" & Range

I did not go through all but this jumped at me. Need one more ampersand

How did you get it to work? Might be interesting, if not helpful, for people searching to solve their similar or same problem.

 

[zookeepertx]

Range("E" & i + 1 & ":E" & Range

I did not go through all but this jumped at me. Need one more ampersand

How did you get it to work? Might be interesting, if not helpful, for people searching to solve their similar or same problem.

Dang it! Those stupid ampersands mess me up all the time! Thanks for the heads up!

Good idea about posting the "fixed" code. Totally slipped my mind!

Here's the portion of the code for what I needed to do. I ended up with no rows between each of the rows with "O" in column E and then the next part of the code inserts those rows. (That part was pretty easy, LOL!)

lr = Range("A" & Rows.Count).End(xlUp).Row
lr2 = Range("A" & Rows.Count).End(xlUp).Row + 6

'Move Ocean rows below Air data
For i = lr To 5 Step -1

    If Range("E" & i).Value = "O" Then
        If Range("E" & i + 1) = "Total" Then
            If Range("E" & i - 1) = "Total" Then
                Rows(i + 1).Delete Shift:=xlUp
                lr2 = lr2 - 1
                Rows(i).Cut
                Rows(lr2).Insert Shift:=xlDown
                lr2 = lr2 - 1
            Else
            Rows(i).Cut
            Rows(lr2).Insert Shift:=xlDown
            lr2 = lr2 - 1
            End If
        Else
        Rows(i).Cut
        Rows(lr2).Insert Shift:=xlDown
        lr2 = lr2 - 1
        End If
  
    End If
Next i

Hope this might help someone in the future!

Jenny

 

[jolivanes]

Thanks for the update and good luck.

 

[zookeepertx]

Thanks for the update and good luck.

Thanks. I could generally use some good luck, LOL!