excelvbanewrow

Insert new Row based on Multiple Cell Logic


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

Solution

  • 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