VBA add 3 empty rows between groups of data and add header

[apoorvaOlly]

I need to separate my data by vendor by adding three rows in between each new vendor and then I need to add a header before each new grouping. I have the following code to enter 3 blank rows between each vendor group. In the 3rd row, I want the headers to be added. So if the data set is:

Vendor Order#
A 123
A 342
B 654
B 654
C 234
C 964

I want it to look like this:

Vendor Order#
A 123
A 342


Vendor Order#
B 654
B 654


Vendor Order#
C 234
C 964

I also need the rows with the same Order#s to be enclosed in a thick border. So both rows of vendor B would be surrounded by a thick border. I'm thinking this will be a loop as well.
Thanks!

My code:

Sub Insert_Groupings()

    Dim LastRow As Long
    Dim i As Integer
    
    Application.ScreenUpdating = False
    
    Worksheets("Picklist").Activate
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    ' insert 3 empty rows between each Vendor
    For i = LastRow To 3 Step -1
        If Cells(i, 1) <> Cells(i - 1, 1) Then
            Rows(i).Resize(3).Insert
            
        End If
    Next i
    
    Application.ScreenUpdating = True
    
End Sub

 

[DanteAmor]

Try this

Sub Insert_Groupings()
  Dim LastRow As Long, i As Integer, j As Long
  
  Application.ScreenUpdating = False
  Worksheets("Picklist").Activate
  LastRow = Range("A" & Rows.Count).End(xlUp).Row
  
  j = LastRow
  ' insert 3 empty rows between each Vendor
  For i = LastRow To 3 Step -1
    If Cells(i, 1) <> Cells(i - 1, 1) Then
      Rows(i).Resize(3).Insert
      Rows(1).Copy Rows(i + 2)
      With Range("A" & i + 3 & ":B" & j + 3)
        .Borders.LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
      End With
      j = i - 1
    End If
  Next i
  
  With Range("A2:B" & j)
    .Borders.LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
  End With
  
  Application.ScreenUpdating = True
End Sub

 

[apoorvaOlly]

This is a good start but it doesn't take into account varied data. The data set I wrote was just an example, a condensed version.
Presently, the code places a border around all the lines once they're grouped by Vendor. However, I only want the borders around lines that have the same Order #. So the first loop will separate by Vendor and the second loop will separate by Order#.

So here is a more representative data set:
Vendor Order #
A 123
A 123
A 654
A 654
B 982
B 352
B 435
B 435
B 435
B 653
C 159
C 573

And this data set is not static. It will change each day as I export the order list every morning. I need to check what lines have the same Order# and insert a thick border around those lines.

Thanks!

 

[DanteAmor]

I don't understand how you want the result.
You could put the sample before the format.
And another sample of the same data after the format.
Use XL2BB tool to put the samples here.

 

[apoorvaOlly]

I'm not an administrator on the computer so I can't install the add-on. I've copy pasted the before and after results. The only thing it doesn't show are the borders I need around the rows that have the same Order#. So for example, the first two lines for Vendor A with Order#123 will be in thick outside border. Apply this to the rest of the data.
Before formatting:

Vendor	Order#
A	123​
A	123​
A	654​
A	756​
B	876​
B	978​
B	978​
B	978​
B	345​
B	675​
B	234​
B	234​
C	537​
C	246​
D	642​
D	642​
D	642​

After formatting:

Vendor	Order#
A	123​
A	123​
A	654​
A	756​
Vendor	Order#
B	876​
B	978​
B	978​
B	978​
B	345​
B	675​
B	234​
B	234​
Vendor	Order#
C	537​
C	246​
Vendor	Order#
D	642​
D	642​
D	642​

I've also attached screenshots if this doesn't accurately show up.

Hope this helps! Thanks!

 

[DanteAmor]

Try this

Sub Insert_Groupings()
  Dim LastRow As Long, i As Integer, j As Long
  Dim ant As Variant, counter As Long
  
  Application.ScreenUpdating = False
  Worksheets("Picklist").Activate
  LastRow = Range("A" & Rows.Count).End(xlUp).Row
  
  j = 2
  ant = Cells(2, "B")
  For i = 2 To LastRow + 1
    If Cells(i, "B") = ant Then
      counter = counter + 1
    Else
      If counter > 1 Then Range("A" & j & ":B" & i - 1).BorderAround xlContinuous, xlThin
      j = i
      counter = 1
    End If
    ant = Cells(i, "B")
  Next
  
  j = LastRow
  ' insert 3 empty rows between each Vendor
  For i = LastRow To 3 Step -1
    If Cells(i, 1) <> Cells(i - 1, 1) Then
      Rows(i).Resize(3).Insert
      Rows(1).Copy Rows(i + 2)
      j = i - 1
    End If
  Next i
  
  Application.ScreenUpdating = True
End Sub

 

[apoorvaOlly]

It worked! Thank you so much!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.