Add a line after each unique value

anichols

Board Regular
Joined
Mar 11, 2021
Messages
67
Office Version
  1. 365
Platform
  1. Windows
Hello all,

I am trying to figure out how to separate some values on my spreadsheet, and I can't seem to think of any effective way to write some vba code to do this automatically.
In Column A (starting from row 2 until the end of data), I have some values. "Secured", "Unsecured", "7A"... They are sorted so rows 2-5 would be "Secured", and maybe 6-10 could be "Unsecured". All the same values would be in sequential rows.
After the last row of any given value, I need insert a new row and define it so I can add formulas and formatting to that row and to that group of rows. (i,e, fill all the "7A" rows yellow, and sum columns, d,e,f)

There are 7 different values that column A could have, and as such, 7 different sections the sheet would be split into. However, some sections may not be present in column a at all.

I'm not looking for a complete solution, rather a few ideas/code snippets that may help me get closer to accomplishing this.

Many thanks!
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

mrshl9898

Well-known Member
Joined
Feb 6, 2012
Messages
1,951
I'd set a first row and last row and loop to find them. Then add the row and do the rest with those 2 values.

Eg:

VBA Code:
Dim firstrow as long
Dim searchrow as long
Dim lastrow as long

searchrow = 2
Do until cells(searchrow, 1) = ""
firstrow = searchrow
  Do until cells(searchrow, 1) <> cells(searchrow + 1,1)
  searchrow = searchrow + 1
  Loop
lastrow = searchrow 
'do the rest here
searchrow = searchrow + 2' skipping your new row
Loop
 

anichols

Board Regular
Joined
Mar 11, 2021
Messages
67
Office Version
  1. 365
Platform
  1. Windows
I'd set a first row and last row and loop to find them. Then add the row and do the rest with those 2 values.

Eg:

VBA Code:
Dim firstrow as long
Dim searchrow as long
Dim lastrow as long

searchrow = 2
Do until cells(searchrow, 1) = ""
firstrow = searchrow
  Do until cells(searchrow, 1) <> cells(searchrow + 1,1)
  searchrow = searchrow + 1
  Loop
lastrow = searchrow
'do the rest here
searchrow = searchrow + 2' skipping your new row
Loop
Perhaps I'm not understanding this code. I put my first value into the "". Then I added a msgbox to test at the commented do the rest here. I don't see anything happening. The problem is, I don't know what the last row would be.
 

mrshl9898

Well-known Member
Joined
Feb 6, 2012
Messages
1,951
Nothing goes in the "" it's going down the column til it hits a blank cell (bottom of the table I assumed)

Starts at row 2, makes that the first row, then goes down row by row until the value below the current row doesn't match what's in column A. Making that row the last row.

From there I'd insert a row under the last row and use first row and last row in your sums etc.

Then it drops down 2 rows, past the new row you inserted and repeats the process til it gets to a blank.
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,853
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows

ADVERTISEMENT

Code:
Sub Maybe()
Application.ScreenUpdating = False
Dim ir As Long
    For ir = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Range("A" & ir) <> Range("A" & ir).Offset(-1, 0) Then
           Range("A" & ir).EntireRow.Insert
        End If
    Next ir
Application.ScreenUpdating = True
End Sub

Deleting and inserting is normally started at the last row and then work your way up.
Easier then the other way around.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
52,302
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

In Column A (starting from row 2 until the end of data), I have some values. "Secured", "Unsecured", "7A"... They are sorted so rows 2-5 would be "Secured", and maybe 6-10 could be "Unsecured". All the same values would be in sequential rows.
After the last row of any given value, I need insert a new row and define it so I can add formulas and formatting to that row and to that group of rows. (i,e, fill all the "7A" rows yellow, and sum columns, d,e,f)
I'm not exactly sure what you are trying to do with the colouring (can you tell us more about that?) but the rest of it sound like Excel's built-in Subtotal feature would be ideal.
Something like this.

Before:

anichols.xlsm
ABCDEF
1ValuesHdr2Hdr3Hdr4Hdr5Hdr6
2SecuredData 1C2683
3SecuredData 2C3747
4SecuredData 3C4787
5SecuredData 4C5261
6UnsecurredData 5C6745
7UnsecurredData 6C7273
8UnsecurredData 7C8797
9UnsecurredData 8C9424
10UnsecurredData 9C10923
11OtherData 10C11613
12OtherData 11C12139
13OtherData 12C13911
14OtherData 13C14628
15
Sheet1


Code:
VBA Code:
Sub ST()
  Range("A1").CurrentRegion.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4, 5, 6)
End Sub

After:

anichols.xlsm
ABCDEF
1ValuesHdr2Hdr3Hdr4Hdr5Hdr6
2SecuredData 1C2683
3SecuredData 2C3747
4SecuredData 3C4787
5SecuredData 4C5261
6Secured Total222618
7UnsecurredData 5C6745
8UnsecurredData 6C7273
9UnsecurredData 7C8797
10UnsecurredData 8C9424
11UnsecurredData 9C10923
12Unsecurred Total292422
13OtherData 10C11613
14OtherData 11C12139
15OtherData 12C13911
16OtherData 13C14628
17Other Total22721
18Grand Total735761
19
Sheet1
Cell Formulas
RangeFormula
D6:F6,D17:F17D6=SUBTOTAL(9,D2:D5)
D12:F12D12=SUBTOTAL(9,D7:D11)
D18:F18D18=SUBTOTAL(9,D2:D16)
 

anichols

Board Regular
Joined
Mar 11, 2021
Messages
67
Office Version
  1. 365
Platform
  1. Windows

Thank you! That works great, and adds new sections for various types of data with such little code! As far as coloring goes, here's an example of what the finished product should look like more or less. This is easy to do by hand, but trying to automate it, is a bit more of a challenge.

Book1
ABCDEFGH
1
2ValuesHdr2Hdr3Hdr4Hdr5Hdr6
3SecuredData 1C2683
4Data 2C3747
5Data 3C4787
6Data 4C5261
7Secured Total222618
8
9UnsecuredData 5C6745
10Data 6C7273
11Data 7C8797
12Data 8C9424
13Data 9C10923
14Unsecured Total292422
15
16OtherData 10C11613
17Data 11C12139
18Data 12C13911
19Data 13C14628
20Other Total22721
21
22Grand Total735761
23
Sheet2
Cell Formulas
RangeFormula
E7:G7,E20:G20E7=SUBTOTAL(9,E3:E6)
E14:G14E14=SUBTOTAL(9,E9:E13)
E22:G22E22=SUBTOTAL(9,E3:E19)
 

anichols

Board Regular
Joined
Mar 11, 2021
Messages
67
Office Version
  1. 365
Platform
  1. Windows
One other note, I am playing around with putting both Count and Average in the field which works great, but I need only some columns to sum,avg,count. and doing it seems to remove all other columns.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
52,302
Office Version
  1. 365
Platform
  1. Windows
here's an example of what the finished product should look like more or less
See if this gets you on the right track. Your sample only provided 3 colour sections so you will need to add further details of the colours that you would want for other sections.

Before:

anichols.xlsm
ABCDEFG
1
2ValuesHdr2Hdr3Hdr4Hdr5Hdr6
3SecuredData 1C2683
4SecuredData 2C3747
5SecuredData 3C4787
6SecuredData 4C5261
7UnsecurredData 5C6745
8UnsecurredData 6C7273
9UnsecurredData 7C8797
10UnsecurredData 8C9424
11UnsecurredData 9C10923
12OtherData 10C11613
13OtherData 11C12139
14OtherData 12C13911
15OtherData 13C14628
16
Sheet3


VBA Code:
Sub ST()
  Dim MyColours As Variant
  Dim FirstRow As Long, LastRow As Long, rw As Long, LastCol As Long, Cols As Long, section As Long
  
  Const HeaderRow As Long = 2
  Const FirstCol As String = "B"
  
  MyColours = Split("15592941 14408667 16247773 15652797 14348258 11854022")  '<- Add more colour pairs here
  
  Application.ScreenUpdating = False
  LastCol = Cells(HeaderRow, Columns.Count).End(xlToLeft).Column
  Cols = LastCol - Columns(FirstCol).Column + 1
  Cells(HeaderRow, FirstCol).CurrentRegion.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4, 5, 6)
  With Cells(HeaderRow, FirstCol).Resize(, Cols).Font
    .Color = vbRed
    .Bold = True
  End With
  FirstRow = HeaderRow + 1
  Application.DisplayAlerts = False
  Do
    LastRow = Columns("B").Find(What:="* Total", After:=Cells(LastRow + 1, "B")).Row - 1
    section = section + 1
    For rw = FirstRow To LastRow Step 2
      Cells(rw, FirstCol).Resize(, Cols).Interior.Color = MyColours(section * 2 - 2)
    Next rw
    With Cells(FirstRow, FirstCol)
      .Resize(LastRow - FirstRow + 1).MergeCells = True
      .VerticalAlignment = xlCenter
      .Font.Bold = True
    End With
    With Cells(LastRow + 1, FirstCol).Resize(, Cols)
      .Offset(1).EntireRow.Insert
      .Interior.Color = MyColours(section * 2 - 1)
      .Font.Bold = True
    End With
    FirstRow = LastRow + 3
  Loop Until Cells(LastRow + 3, FirstCol).Value = "Grand Total"
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

After:

anichols.xlsm
ABCDEFG
1
2ValuesHdr2Hdr3Hdr4Hdr5Hdr6
3SecuredData 1C2683
4Data 2C3747
5Data 3C4787
6Data 4C5261
7Secured Total222618
8
9UnsecurredData 5C6745
10Data 6C7273
11Data 7C8797
12Data 8C9424
13Data 9C10923
14Unsecurred Total292422
15
16OtherData 10C11613
17Data 11C12139
18Data 12C13911
19Data 13C14628
20Other Total22721
21
22Grand Total735761
Sheet3
Cell Formulas
RangeFormula
E7:G7,E20:G20E7=SUBTOTAL(9,E3:E6)
E14:G14E14=SUBTOTAL(9,E9:E13)
E22:G22E22=SUBTOTAL(9,E3:E19)



I am playing around with putting both Count and Average in the field which works great, but I need only some columns to sum,avg,count. and doing it seems to remove all other columns.
Would need more specific details about this.
Also note that I may not be back to look at this for some time as I am about to be away for a period of time. However, somebody else may be able to chime in if you still need further help.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,119
Messages
5,768,221
Members
425,460
Latest member
Astros1243

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top