Add a line after each unique value

[anichols]

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!

 

[mrshl9898]

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:

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]

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:

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]

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]

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.

 

[mrshl9898]

how does that look with the the summing and coloring the rows etc?

 

[Peter_SSs]

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
	A	B	C	D	E	F
1	Values	Hdr2	Hdr3	Hdr4	Hdr5	Hdr6
2	Secured	Data 1	C2	6	8	3
3	Secured	Data 2	C3	7	4	7
4	Secured	Data 3	C4	7	8	7
5	Secured	Data 4	C5	2	6	1
6	Unsecurred	Data 5	C6	7	4	5
7	Unsecurred	Data 6	C7	2	7	3
8	Unsecurred	Data 7	C8	7	9	7
9	Unsecurred	Data 8	C9	4	2	4
10	Unsecurred	Data 9	C10	9	2	3
11	Other	Data 10	C11	6	1	3
12	Other	Data 11	C12	1	3	9
13	Other	Data 12	C13	9	1	1
14	Other	Data 13	C14	6	2	8
15
Sheet1

Code:

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

After:

anichols.xlsm
	A	B	C	D	E	F
1	Values	Hdr2	Hdr3	Hdr4	Hdr5	Hdr6
2	Secured	Data 1	C2	6	8	3
3	Secured	Data 2	C3	7	4	7
4	Secured	Data 3	C4	7	8	7
5	Secured	Data 4	C5	2	6	1
6	Secured Total			22	26	18
7	Unsecurred	Data 5	C6	7	4	5
8	Unsecurred	Data 6	C7	2	7	3
9	Unsecurred	Data 7	C8	7	9	7
10	Unsecurred	Data 8	C9	4	2	4
11	Unsecurred	Data 9	C10	9	2	3
12	Unsecurred Total			29	24	22
13	Other	Data 10	C11	6	1	3
14	Other	Data 11	C12	1	3	9
15	Other	Data 12	C13	9	1	1
16	Other	Data 13	C14	6	2	8
17	Other Total			22	7	21
18	Grand Total			73	57	61
19
Sheet1

Cell Formulas
Range	Formula
D6:F6,D17:F17	D6	=SUBTOTAL(9,D2:D5)
D12:F12	D12	=SUBTOTAL(9,D7:D11)
D18:F18	D18	=SUBTOTAL(9,D2:D16)

 

[anichols]

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
	A	B	C	D	E	F	G	H
1
2		Values	Hdr2	Hdr3	Hdr4	Hdr5	Hdr6
3		Secured	Data 1	C2	6	8	3
4			Data 2	C3	7	4	7
5			Data 3	C4	7	8	7
6			Data 4	C5	2	6	1
7		Secured Total			22	26	18
8
9		Unsecured	Data 5	C6	7	4	5
10			Data 6	C7	2	7	3
11			Data 7	C8	7	9	7
12			Data 8	C9	4	2	4
13			Data 9	C10	9	2	3
14		Unsecured Total			29	24	22
15
16		Other	Data 10	C11	6	1	3
17			Data 11	C12	1	3	9
18			Data 12	C13	9	1	1
19			Data 13	C14	6	2	8
20		Other Total			22	7	21
21
22		Grand Total			73	57	61
23
Sheet2

Cell Formulas
Range	Formula
E7:G7,E20:G20	E7	=SUBTOTAL(9,E3:E6)
E14:G14	E14	=SUBTOTAL(9,E9:E13)
E22:G22	E22	=SUBTOTAL(9,E3:E19)

 

[anichols]

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]

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
	A	B	C	D	E	F	G
1
2		Values	Hdr2	Hdr3	Hdr4	Hdr5	Hdr6
3		Secured	Data 1	C2	6	8	3
4		Secured	Data 2	C3	7	4	7
5		Secured	Data 3	C4	7	8	7
6		Secured	Data 4	C5	2	6	1
7		Unsecurred	Data 5	C6	7	4	5
8		Unsecurred	Data 6	C7	2	7	3
9		Unsecurred	Data 7	C8	7	9	7
10		Unsecurred	Data 8	C9	4	2	4
11		Unsecurred	Data 9	C10	9	2	3
12		Other	Data 10	C11	6	1	3
13		Other	Data 11	C12	1	3	9
14		Other	Data 12	C13	9	1	1
15		Other	Data 13	C14	6	2	8
16
Sheet3

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
	A	B	C	D	E	F	G
1
2		Values	Hdr2	Hdr3	Hdr4	Hdr5	Hdr6
3		Secured	Data 1	C2	6	8	3
4			Data 2	C3	7	4	7
5			Data 3	C4	7	8	7
6			Data 4	C5	2	6	1
7		Secured Total			22	26	18
8
9		Unsecurred	Data 5	C6	7	4	5
10			Data 6	C7	2	7	3
11			Data 7	C8	7	9	7
12			Data 8	C9	4	2	4
13			Data 9	C10	9	2	3
14		Unsecurred Total			29	24	22
15
16		Other	Data 10	C11	6	1	3
17			Data 11	C12	1	3	9
18			Data 12	C13	9	1	1
19			Data 13	C14	6	2	8
20		Other Total			22	7	21
21
22		Grand Total			73	57	61
Sheet3

Cell Formulas
Range	Formula
E7:G7,E20:G20	E7	=SUBTOTAL(9,E3:E6)
E14:G14	E14	=SUBTOTAL(9,E9:E13)
E22:G22	E22	=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.