VBA for Automatically Resizing Rows if Data is Entered

Topic

New Reply

Hi there,

Not sure if this is possible to do or not.

I have a spreadsheet where i have a “Mastersheet” where all the data i require is entered. This data is then spread into different spreadsheets.
I have a total of 30 rows that might have data but sometimes not all 30 cells will have data in them, they will return the value “0”.

Now here is where i need the VBA.
I want the cells that show values to automatically resize the entire row to fit an A4 page.

If cells A1 to A25 have data then i want the rows to automatically resize to fit an A4 page, however the cells with no data in A26 to A30 i don’t need to be printed so they can be hidden or something.

I want each spreadsheet to appear this way.

Thanks

Reply | Quote

Replies

cremorneguy,

I’m not exactly sure which way you want to resize the cells, e.g. to fit left to right, or to fit top to bottom (fill the entire page by adjusting row height), or both?

:cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi RetiredGeek,

I want it to resize to fit top to bottom. Left to right (column size) is already set and i don’t want that to change. I only want the rows to resize so that it fits to A4 page for printing. I don’t want to have to manually change sizes or set anything up for printing which i have to do, i have colleagues that will use the file also and they aren’t skilled at excel (not even Basic Excel really) so i want everything set up to automatically do this stuff so they only have enter data then print the page.

I’ve attached a copy of the file, the first tab titled “Start Here” is where the data will be entered. The second tab titled “Without Macro” is what it’s doing now, so i have to manually adjust the size of the rows and you can see that some rows have no data near the bottom. The third tab titled “What i want as a result of a macro” is pretty much what i want the file to do with a macro, automatically resize cells and hide any rows that have no data but so it fits to an A4 page for printing.

Its alot to ask for and not sure if its possible but any help would be amazing!

Reply | Quote

cremorneguy,

Looking at your sample file I gather that there is some way the data gets from the Start Here sheet to the secondary formatted sheet that is not included in the sample file?

On this formatted sheet how do I deterimine where the data ends, e.g. will column A be Blank or Zero?

What are your top/bottom margin settings (necessary to figure the printable area)?

I’m currently on the road returning from vacation so I won’t be able to get to this until Monday. I’ll dig in then if no one else has solved it by then.

The approach I plan to take is:

[*]Determine the last row to be printed & set the Print Area.
[*]Calculate the total printable page area.
[*]Subtract the height of the first 8 rows.
[*]Divide the remaining space by the number of data rows.
[*]Set the row height for the data rows.

:cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi there,

Firstly, yes i have the data coming from Start Here just by the formula =’Start Here’!A9 etc.

Column A is actually giving the result 0 but i’ve formatted the cells so that the 0 is hidden using 0;-0;;@

i Dont want the first 8 rows to change or be deleted, this is the heading of the page when printed.

I only want rows 9 through to 37 to resize if there is data showing in column A, if the rows are showing blank/0 then the size of the cells virtually disappear.

Once thats done, i want everything that’s visible to fit into a printable area.

I want this done as sometimes data will be deleted making less visible data and at other times there might be more data appearing so i need the rows to resize to fit the printable area.

Reply | Quote

cremorneguy,

See if this meets your needs. Click on the button on the sheet to run the code.

HTH,
Maud

Code:

Sub FormatSheet()
    Application.ScreenUpdating = False
    Rows(“9:25”).Select
    Selection.RowHeight = 42
    ActiveSheet.PageSetup.PrintArea = “$A$1:$M$25”
    Rows(“26:37”).EntireRow.Hidden = True
    [a1].Select
    Application.ScreenUpdating = True
End Sub

Reply | Quote

cremorneguy,

Ok here’s a possible solution.

Observations:
1. Your test file has Custom Margins set to 0 and I worked from there though I don’t know of any printer that can print to the size of the page.
2. The 8 Header rows use up approximately 1.5″ which would seem to leave 9.5″ of usable space however, I found a useable space of 10″ still leaves a little unused space at the bottom (highlighted in yellow in the graphic). I’ve tried to craft the code so it is easy for your to change the parameters and experiment for best results in your environment. Personally, I wouldn’t try to use all the space as the calculations could in some circumstances cause the data area to overflow the page size.
3. The macro is designed to work on the Active Sheet! It would be advisable to limit the macro to only work on the sheet it is designed for as follows:

Code:

   If ActiveSheet.Name  "Your Sheet Name Here!" Then Exit Sub

Place that line just following the last Dim statement.

Sample Results:
38086-resizerows

Code:

Option Explicit

Sub ResizeRows()

   Dim dAvailableSpace As Double
   Dim dRowHeight      As Double
   Dim lHdrRowCnt      As Long
   Dim lRowCnt         As Long
   Dim lCntr           As Long
   
   Application.ScreenUpdating = False
   
   '*** Initialize Variables ***
   dAvailableSpace = 10      '*** In inches!               ***
   lHdrRowCnt = 8            '*** Number of Header Rows    ***
   
   '*** Count Data Rows ***
   lRowCnt = 0               '*** Initialize Row Counter      ***
   lCntr = lHdrRowCnt        '*** Start at last Header Row    ***
   Do                        '*** Assumes at least 1 data row ***
       lRowCnt = lRowCnt + 1
       lCntr = lCntr + 1
   Loop Until Cells(lCntr + 1, 1).Value = 0
   
   '*** Calculate Row Height                                  ***
   '*** Note: Row Height is set in Points! 72 points = 1 inch ***
   dRowHeight = Round(dAvailableSpace / lRowCnt, 3) * 72
   
   '*** Select Rows and apply height ***
   Rows(Format(lHdrRowCnt + 1) & ":" & _
        Format(8 + lRowCnt)).RowHeight = dRowHeight
        
End Sub    'ReSizeRows()

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote