基于多单元格逻辑插入新行

Question

I'm pretty new to VBA and I've searched as best as I can but I still can't find an answer. I need to write a Macro that will insert a new line based on multiple conditions. The rows have to be in groups no larger than 5 and separated by carrier. But if a Container is repeating, it counts as 1 row.

Current:

Container   Carrier
ABC56   Carrier 1
XOS752  Carrier 1
IOW45   Carrier 1
WOFJ74  Carrier 1
NMC85   Carrier 1
DDJD7   Carrier 1
DFF789  Carrier 1
DFF789  Carrier 1
CSGS    Carrier 1
GSW132  Carrier 1
WYWI78  Carrier 1
WTS758  Carrier 1
MNV74   Carrier2
ADS78   Carrier2
CTDS45  Carrier2
CTDS45  Carrier2
LHKGL78 Carrier2
XJSS772 Carrier2
XJSHS7  Carrier2
OIJS7   Carrier2

Desired:

ABC56   Carrier 1
XOS752  Carrier 1
IOW45   Carrier 1
WOFJ74  Carrier 1
NMC85   Carrier 1

DDJD7   Carrier 1
DFF789  Carrier 1
DFF789  Carrier 1
CSGS    Carrier 1
GSW132  Carrier 1
WYWI78  Carrier 1

WTS758  Carrier 1

MNV74   Carrier2
ADS78   Carrier2
CTDS45  Carrier2
CTDS45  Carrier2
LHKGL78 Carrier2
XJSS772 Carrier2

XJSHS7  Carrier2
OIJS7   Carrier2

I will take any direction you have! I have these two codes separately. One Separates by Carrier and One Separates into 5 row increments. However, It doens't have all the logic built in.

To separate into groups of 5:

Option Explicit
    Sub InsertIT()
    Dim x As Integer
    x = 1 'Start Row
    Do
    Range("A" & x, "B" & x).Insert
    x = x + 6
    Loop
    End Sub

To separate by Carrier:

 Sub InsertRowAtChangeInValue()
       For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1
          If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then Rows(lRow).EntireRow.Insert
       Next lRow
    End Sub

Answer 1

I copied your sample data, and this macro gives me the output you're looking for.

I used a while loop instead of a for loop because VBA records the value for the end of the for loop when it starts, and the number of rows you need to process changes as you insert rows.

I'm using the concept of a counter that increments only when conditions are met to account for the repeat container and carrier rows.

I'm also using the concept of flag-setting to take the correct action when a carrier change is detected. As you learn and grow in writing vba, if you choose to use flags, remember to reset them as necessary as I've done here.

Finally, I included the user message at the end as a quick cognitive check for the functionality of the macro. Based on the user message, you can quickly scroll to the row indicated and check whether the macro processed the whole sheet. I find it helpful to include these messages to check my work and help my users catch errors.

If you have questions, please comment!

Sub RowInsert()

'Designate your data columns
ContainerCol = "A"
CarrierCol = "B"

'Designate where your data starts
FirstDataRow = 2

'Find last row to process
LastRow = Range(ContainerCol & Rows.Count).End(xlUp).Row

'Initialize variable for row counter
RowCount = 0

'Initialize while loop variable
i = FirstDataRow

'Loop while ContainerCol is populated
While Not IsEmpty(Cells(i, ContainerCol))

    'Check if container and carrier are repeated from previous row. Increment counter if no repetition
    If Cells(i, CarrierCol) <> Cells(i - 1, CarrierCol) Or Cells(i, ContainerCol) <> Cells(i - 1, ContainerCol) Then
        RowCount = RowCount + 1
    End If

    'Check if carrier changes on next row
    changeflag = 0 'Variable to indicate if carrier change detected, flag reset
    If Cells(i, CarrierCol) <> Cells(i + 1, CarrierCol) Then
        changeflag = 1
    End If

    'Insert row if carrier changing or 5 rows complete
    If RowCount >= 5 Or changeflag = 1 Then
        Rows(i + 1).EntireRow.Insert
        i = i + 1 'Increment so that the loop picks up at the right spot on the next iteration
        RowCount = 0 'Reset row counter
    End If

    'Increment loop counter
    i = i + 1

Wend

MsgBox ("Separated rows until blank was found at row " & i - 1 & ".")

End Sub

Answer 2

you could avoid loops exploiting a helper column (column C, in my following example):

Sub InsertRows()
    With Range("A2", Cells(Rows.Count, "A").End(xlUp)).Offset(, 4)
        With .Offset(1).Resize(.Rows.Count - 1)
            .FormulaR1C1 = "=IF(RC2<>R[-1]C2,1,"""")"
            .Value = .Value
            .SpecialCells(xlCellTypeConstants).EntireRow.Insert
        End With
        .FormulaR1C1 = "=IF(RC2="""",0,IF(RC1<>R[-1]C1,IF(R[-1]C=5,1,R[-1]C+1), R[-1]C))"
        .Value = .Value
        .Replace what:=5, replacement:=""
        .Resize(.Rows.Count - 1).SpecialCells(xlCellTypeBlanks).Offset(1).EntireRow.Insert
        .ClearContents
    End With
End Sub

and you can change the helper column as you need by simply changing .Offset(, 2) to some other .Offset(, n)