Macro or formatting to always show one extra row in a section

[muhleebbin]

Hi,

I have the following sample data set that could change project by project. Is there a way where I can add 50 extra rows into each section but only have it automatically show 1 extra row in the section so it's not overly long to scroll through and print?

Projects constantly change and evolve and would like to make the spreadsheet capable of growing with the projects.

200618 - Lambert - June Billing Hours.xlsx
	B	C
1	Item	Description
2	001	Main driveway curbing, not to exceed amount
3	002	Type 1 - Flagstone cladding and cap, not to exceed amount
4	003	Type 2 - Flagstone cladding and cap, not to exceed amount
5	004	Type 3 - Flagstone cladding and cap, not to exceed amount
6	Site, Extra 01 Subtotal:
7	005	Laundry Room Tile Floor, Not to exceed amount
8	006	Bathroom 006, Not to exceed amount
9	007	Reserve Closet 005, Not to exceed amount
10	008	Circulation 007 Tile Flooring, Not to exceed amount
11	009	Circulation 106, Powder 103 Tile Flooring, Not to exceed amount
12	010	Kitchen 201, Breakfast 202, Living 203, Dining 204, Pantry 205 Tile Floor, Not to exceed amount
13	011	Circulation 208 Stairs – nosing, tread, riser, Not to exceed amount
14	012	Living Room 203 Fireplace Facing and Mantle, Not to exceed amount
15	013	Circulation 208, Powder 206, Mud 207, Hall R245 Tile Flooring, Not to exceed amount
16	014	Master Bath 302 Flooring, Not to exceed amount
17	015	Shower Wall & Floor, Not to exceed amount
18	016	Wall Cladding & Base at 301A and 302B, Not to exceed amount
19	017	Bath 307 Tile Flooring, Not to exceed amount
20	018	Bath 307 Shower Tile, Not to exceed amount
21	019	Bath 310 Tile Flooring, Not to exceed amount
22	020	Bath 310 Shower Tile, Not to exceed amount
23	021	Circulation 106 Stair Treads and Risers, Not to exceed amount
24	022	Circulation 006 Stair Treads and Risers
25	023	Main Stair Treads, Risers, and Landings, Not to exceed amount
26	024	Yoga Room Countertop, Not to exceed amount
27	025	Reserve Closet 005 Corian Countertop, Not to exceed amount
28	026	Powder Room 103 Corian Countertop, Not to exceed amount
29	027	Kitchen 201 Counters, Not to exceed amount
30		Kitchen Table Top & End Waterfall
31	028	Powder 206 - Countertop, Not to exceed amount
32	029	Mud Room 207 – Countertop and splash, Not to exceed amount
33	030	Pantry 205 – Countertop and splash, Not to exceed amount
34	031	Lisa’s Closet 301 – Slab Island Top, Not to exceed amount
35	032	Lisa’s Closet 301 – Perimeter Counters, Not to exceed amount
36	033	Master Bath 302 Vanity Top, Not to exceed amount
37	034	Master Bath 302 Water Closet Counters, Not to exceed amount
38	035	Master Bath 302 Tub Deck & Risers, Not to exceed amount
39	036	Charles Closet 304 Countertop, Not to exceed amount
40	037	Bath 307 Vanity Top, Not to exceed amount
41	038	Bath 310 Vanity Top, Not to exceed amount
42	039	Reserve Closet 311 Countertops, Not to exceed amount
43		Master Bedroom Wall Cladding, added in Bulletin 12
44	Addition, Extra 02 Subtotal:
NTE Tracking Log

 

[Peter_SSs]

add 50 extra rows into each section

Assuming that a 'section' means those rows between the empty cells in column C, then try this with a copy of your workbook.

Sub Insert_Rows()
  Dim cell As Range
  
  Const RowsToAdd As Long = 50
  
  Application.ScreenUpdating = False
  For Each cell In Range("C2:C" & Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlBlanks)
    cell.EntireRow.Resize(RowsToAdd).Insert
    cell.Offset(-RowsToAdd).EntireRow.Resize(RowsToAdd - 1).Hidden = True
  Next cell
  Application.ScreenUpdating = True
End Sub

 

[muhleebbin]

Peter,

Thank you very much for the response. I actually didn't explain that very well and the macro almost did it perfectly however. Below is a sample of what was produced and hopefully clarifying info as to what the goal is ?

Book1
	A	B	C
1		Item	Description
2		001	Main driveway curbing, not to exceed amount
3		002	Type 1 - Flagstone cladding and cap, not to exceed amount
4		003	Type 2 - Flagstone cladding and cap, not to exceed amount
5		004	Type 3 - Flagstone cladding and cap, not to exceed amount
55
Sheet1

I actually didn't mean for the macro to add the rows in, itself. I meant to say if I have already expanded the sections (let's say to 100 rows), is there a way to only show lines 2-6 vs the version above showing lines 2-5 and then line 55. The reason I'd like to show 6 is so that if our project managers need to add to the scope of work, they can start typing it into line 6 and if line 6 then has data in either columns b or c then line 7 will show and so forth. Also if line 6 were cleared out (B and/or C being the criteria that governs whether the next blank line is shown) than it would go back to showing lines 2-6 vs 2-7. Basically the macro shows the next blank line in a section and could expand or contract to however big the scope of work is. Hopefully that makes a little more sense (only showing a few extra rows in the example below).

Book2
	B	C
1	Item	Description
2	001	Main driveway curbing, not to exceed amount
3	002	Type 1 - Flagstone cladding and cap, not to exceed amount
4	003	Type 2 - Flagstone cladding and cap, not to exceed amount
5	004	Type 3 - Flagstone cladding and cap, not to exceed amount
6
7
8
9
10
11	Site, Extra 01 Subtotal:
12	005	Laundry Room Tile Floor, Not to exceed amount
13	006	Bathroom 006, Not to exceed amount
14	007	Reserve Closet 005, Not to exceed amount
15	008	Circulation 007 Tile Flooring, Not to exceed amount
16	009	Circulation 106, Powder 103 Tile Flooring, Not to exceed amount
17	010	Kitchen 201, Breakfast 202, Living 203, Dining 204, Pantry 205 Tile Floor, Not to exceed amount
18	011	Circulation 208 Stairs – nosing, tread, riser, Not to exceed amount
19	012	Living Room 203 Fireplace Facing and Mantle, Not to exceed amount
20	013	Circulation 208, Powder 206, Mud 207, Hall R245 Tile Flooring, Not to exceed amount
21	014	Master Bath 302 Flooring, Not to exceed amount
22	015	Shower Wall & Floor, Not to exceed amount
23	016	Wall Cladding & Base at 301A and 302B, Not to exceed amount
24	017	Bath 307 Tile Flooring, Not to exceed amount
25	018	Bath 307 Shower Tile, Not to exceed amount
26	019	Bath 310 Tile Flooring, Not to exceed amount
27	020	Bath 310 Shower Tile, Not to exceed amount
28	021	Circulation 106 Stair Treads and Risers, Not to exceed amount
29	022	Circulation 006 Stair Treads and Risers
30	023	Main Stair Treads, Risers, and Landings, Not to exceed amount
31	024	Yoga Room Countertop, Not to exceed amount
32	025	Reserve Closet 005 Corian Countertop, Not to exceed amount
33	026	Powder Room 103 Corian Countertop, Not to exceed amount
34	027	Kitchen 201 Counters, Not to exceed amount
35		Kitchen Table Top & End Waterfall
36	028	Powder 206 - Countertop, Not to exceed amount
37	029	Mud Room 207 – Countertop and splash, Not to exceed amount
38	030	Pantry 205 – Countertop and splash, Not to exceed amount
39	031	Lisa’s Closet 301 – Slab Island Top, Not to exceed amount
40	032	Lisa’s Closet 301 – Perimeter Counters, Not to exceed amount
41	033	Master Bath 302 Vanity Top, Not to exceed amount
42	034	Master Bath 302 Water Closet Counters, Not to exceed amount
43	035	Master Bath 302 Tub Deck & Risers, Not to exceed amount
44	036	Charles Closet 304 Countertop, Not to exceed amount
45	037	Bath 307 Vanity Top, Not to exceed amount
46	038	Bath 310 Vanity Top, Not to exceed amount
47	039	Reserve Closet 311 Countertops, Not to exceed amount
48		Master Bedroom Wall Cladding, added in Bulletin 12
49
50
51
52
53
54	Addition, Extra 02 Subtotal:
55	040	Pool House Floor Tile, Not to exceed amount
Sheet1

 

[Peter_SSs]

Hmm, I'm not sure that I have understood that fully but try this Worksheet_Change code with a copy of your workbook. To implement ..
1. Right click the sheet name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test.
4. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range, c As Range
  Dim LastRow As Long
  
  Set Changed = Intersect(Target, Columns("B:C"))
  If Not Changed Is Nothing Then
    Application.ScreenUpdating = False
    LastRow = Range("B" & Rows.Count).End(xlUp).Row
    For Each c In Changed
      If IsEmpty(Cells(c.Row + 1, "B").Value) And IsEmpty(Cells(c.Row + 1, "C").Value) And c.Row < LastRow Then
        With Range(Cells(c.Row + 1, "B").End(xlUp), Cells(c.Row, "B").End(xlDown))
          .EntireRow.Hidden = False
          If .Rows.Count > 4 Then .Offset(2).Resize(.Rows.Count - 4).EntireRow.Hidden = True
        End With
      End If
    Next c
    Application.ScreenUpdating = True
  End If
End Sub

 

[muhleebbin]

When I insert the code I get the attached error message.

I'll try to explain further what the end goal is. Original data would look like this without any macro:

SVAR Actual - Budget v2.xlsm
	A	B	C	D	E	F
1	COR-PCO Number:
2
3	Change Order:
4
5	RFI/Bulletin/ROM:
6
7	Status:
8
9	Item #	Description	Material Unit Price	Shop Labor	Site Labor	Total
10	001	Main driveway curbing, not to exceed amount	-	-	-	-
11	002	Type 1 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
12	003	Type 2 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
13	004	Type 3 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
14	005	Test	-	-	-	-
15
16
17
18
19
20
21
22
23
24
25
26
27	Site, Extra 01 Subtotal:		-	-	-	-
Input

Cell Formulas
Range	Formula
F10:F14,F27	F10	=SUM(C10:E10)

Cells with Data Validation
Cell	Allow	Criteria
D7:F7	List	=Lists!$Y$1:$Y$3

As you could imagine, multiple sections of this and a much more complex scope of work, there would be quite a bit to scroll through. What i'm hoping the macro would do is to only show items 001 - 004 plus one extra line (line 14 in this example hiding rows 15-26):

SVAR Actual - Budget v2.xlsm
	A	B	C	D	E	F
1	COR-PCO Number:
2
3	Change Order:
4
5	RFI/Bulletin/ROM:
6
7	Status:
8
9	Item #	Description	Material Unit Price	Shop Labor	Site Labor	Total
10	001	Main driveway curbing, not to exceed amount	-	-	-	-
11	002	Type 1 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
12	003	Type 2 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
13	004	Type 3 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
14
27	Site, Extra 01 Subtotal:		-	-	-	-
Input

Cell Formulas
Range	Formula
F10:F13,F27	F10	=SUM(C10:E10)

Cells with Data Validation
Cell	Allow	Criteria
D7:F7	List	=Lists!$Y$1:$Y$3

Also if the macro could account for any expansion or contraction of the project. If our project managers add data to line 14 then it automatically shows line 15 like so:

SVAR Actual - Budget v2.xlsm
	A	B	C	D	E	F
1	COR-PCO Number:
2
3	Change Order:
4
5	RFI/Bulletin/ROM:
6
7	Status:
8
9	Item #	Description	Material Unit Price	Shop Labor	Site Labor	Total
10	001	Main driveway curbing, not to exceed amount	-	-	-	-
11	002	Type 1 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
12	003	Type 2 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
13	004	Type 3 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
14	005	Test	-	-	-	-
15
27	Site, Extra 01 Subtotal:		-	-	-	-
Input

Cell Formulas
Range	Formula
F10:F14,F27	F10	=SUM(C10:E10)

Cells with Data Validation
Cell	Allow	Criteria
D7:F7	List	=Lists!$Y$1:$Y$3

And vice versa, if they delete a line that it would revert back (if line 14 were cleared out then it would go back to the second example above)

 

[Peter_SSs]

Your error message indicates that you already have a Worksheet_Change code for that worksheet. Since only one is permitted, any code provided here would have to be amalgamated with your existing code and that could only be done successfully if we know what that existing code is. Can you post it?

Secondly, this layout is somewhat different to what was posted originally ..
- Those extra rows at the top of the sheet are new to us
- Item & Description appear to have moved from columns B:C to columns A:B

Is it correct that the code you are seeking only needs to apply from row 9 and down?

Given all that, please note that I am likely to be away from the forum for at least a week very soon. If not resolved before I leave, I will look back here on my return to see if somebody else has stepped in and solved it for you.

 

[muhleebbin]

Gotcha, I was building this off of another workbook that was complete and in good working order and will eliminate the other code as it is irrelevant to this new use and test again in the morning.

I apologize for the shift and new format as I am only beginning to put this new workbook together, but yes this new code will only be used from row 9 going forward.

fyi, I was looking to use this code on other sheets within the workbook as well. As this first sheet will take in change orders and updates in the budget of our projects, subsequent sheets will mirror the line items for reporting purposes and thus would need this macro so that there’s no unnecessary scrolling.

Regardless, thank you for taking the time in assisting with this project

 

[muhleebbin]

Peter,

This primarily worked! Minor tweak, if possible? Could it be coded where line 26 doesn't show? Right now this is what it's currently showing (it's also occurring further down the sheet)

SVAR Actual - Budget v2.xlsm
	A	B	C	D	E	F
1	COR-PCO Number:
2
3	Change Order:
4
5	RFI/Bulletin/ROM:
6
7	Status:
8
9	Item #	Description	Material Unit Price	Shop Labor	Site Labor	Total
10	001	Main driveway curbing, not to exceed amount	-	-	-	-
11	002	Type 1 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
12	003	Type 2 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
13	004	Type 3 - Flagstone cladding and cap, not to exceed amount	-	-	-	-
14	005	Test	-	-	-	-
15
26
27	Site, Extra 01 Subtotal:		-	-	-	-
Input

Cell Formulas
Range	Formula
F10:F14,F27	F10	=SUM(C10:E10)

Cells with Data Validation
Cell	Allow	Criteria
D7:F7	List	=Lists!$Y$1:$Y$3

 

[Peter_SSs]

Try this version

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range, c As Range
  Dim FirstRow As Long, LastRow As Long

  Set Changed = Intersect(Target, Columns("A:B"), Rows("9:" & Rows.Count))
  If Not Changed Is Nothing Then
    Application.ScreenUpdating = False
    For Each c In Changed
      If IsEmpty(Cells(c.Row + 1, "A").Value) And IsEmpty(Cells(c.Row + 1, "B").Value) Then
        LastRow = Cells(c.Row + 1, "A").End(xlDown).Row
        FirstRow = Columns("A:B").Find(What:="*", After:=Cells(LastRow, "A"), SearchDirection:=xlPrevious).Row
        Rows(FirstRow & ":" & LastRow).Hidden = False
        If LastRow < Rows.Count And LastRow - FirstRow > 2 Then Rows(FirstRow + 2 & ":" & LastRow - 1).Hidden = True
      End If
    Next c
    Application.ScreenUpdating = True
  End If
End Sub

 

[muhleebbin]

Peter,

This works perfectly! Thank you very much for your time on this!

This will help manage our projects a lot more seamlessly and save one of our project managers an unreal amount of time of hand calculating etc.