Auto Un hide Rows

Cooki

Board Regular
Joined
Jul 31, 2018
Messages
75
Hi All

Im after some code that will always make sure that there are 10 rows available from the last row with data on and have the formulas and formatting still in.

I have hidden rows and columns to make it look much neater, but if they need to enter more 10 tasks in, will need to unhide, copy everything down and hide again.

So im hoping it would work like, if they enter 5 more rows of data and save the document, another 5 rows would be added to the bottom which would be total of 10 rows.

Columns go across to R.

Is this possible and if so could someone please help?
 

Cooki

Board Regular
Joined
Jul 31, 2018
Messages
75
These are the columns with the formulas in B,D,E,F,K,L,M,N,O.

Last row is R

And yes correct dont want to copy the hard data lol
 

Some videos you may like

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,940
Office Version
  1. 365
Platform
  1. Windows
OK, go into the VB Editor, make sure VB Project Explorer is open (down left-hand side), find your file, and expand the folders under that file name to expose all the Microsoft Excel Object under it.
The last one should be named "ThisWorkbook". Click on that, and copy/paste the following code into the VB Editor window:
VBA Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim lr As Long, ls As Long
    Dim snr As Long, enr As Long
    Dim c As Long
    
    Application.ScreenUpdating = False

'   Find last row with data, by looking at column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Find last shown row on sheet
    ls = Cells.SpecialCells(xlCellTypeVisible).Rows.Count
    
'   Find start of new rows to be added
    snr = ls + 1
    
'   Find end of new rows to be added
    enr = lr + 10
    
'   Unhide new rows, if necessary
    If enr > ls Then
        Rows(ls + 1 & ":" & enr).EntireRow.Hidden = False
'       Copy formatting for each column
        For c = 1 To 18
            Cells(ls, c).Copy
            Range(Cells(ls + 1, c), Cells(enr, c)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
        Next c
'       Copy formulas down
        Cells(ls, "B").Copy Range(Cells(ls + 1, "B"), Cells(enr, "B"))
        Range(Cells(ls, "D"), Cells(ls, "F")).Copy Range(Cells(ls + 1, "D"), Cells(enr, "D"))
        Range(Cells(ls, "K"), Cells(ls, "O")).Copy Range(Cells(ls + 1, "K"), Cells(enr, "K"))
    End If
    
    Application.ScreenUpdating = True

End Sub
Then, as long as you have VBA enabled, whenever you save the file, it will always make sure to unhide enough rows so that there will be exactly 10 blank rows at the bottom.
 

Cooki

Board Regular
Joined
Jul 31, 2018
Messages
75
OK, go into the VB Editor, make sure VB Project Explorer is open (down left-hand side), find your file, and expand the folders under that file name to expose all the Microsoft Excel Object under it.
The last one should be named "ThisWorkbook". Click on that, and copy/paste the following code into the VB Editor window:
VBA Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim lr As Long, ls As Long
    Dim snr As Long, enr As Long
    Dim c As Long
   
    Application.ScreenUpdating = False

'   Find last row with data, by looking at column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Find last shown row on sheet
    ls = Cells.SpecialCells(xlCellTypeVisible).Rows.Count
   
'   Find start of new rows to be added
    snr = ls + 1
   
'   Find end of new rows to be added
    enr = lr + 10
   
'   Unhide new rows, if necessary
    If enr > ls Then
        Rows(ls + 1 & ":" & enr).EntireRow.Hidden = False
'       Copy formatting for each column
        For c = 1 To 18
            Cells(ls, c).Copy
            Range(Cells(ls + 1, c), Cells(enr, c)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
        Next c
'       Copy formulas down
        Cells(ls, "B").Copy Range(Cells(ls + 1, "B"), Cells(enr, "B"))
        Range(Cells(ls, "D"), Cells(ls, "F")).Copy Range(Cells(ls + 1, "D"), Cells(enr, "D"))
        Range(Cells(ls, "K"), Cells(ls, "O")).Copy Range(Cells(ls + 1, "K"), Cells(enr, "K"))
    End If
   
    Application.ScreenUpdating = True

End Sub
Then, as long as you have VBA enabled, whenever you save the file, it will always make sure to unhide enough rows so that there will be exactly 10 blank rows at the bottom.

Works absolutely perfect

Thank you so much
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,940
Office Version
  1. 365
Platform
  1. Windows
You are welcome.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,780
Messages
5,598,038
Members
414,205
Latest member
Tushark

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