Auto-resize row

L

liampog

Active Member
Joined
Aug 3, 2010
Messages
308
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi there

I have an print area set up and I want to be able to automatically resize the rows and print area (through a macro) depending on the number of rows that are occupied by data.

The more rows occupied, the smaller the row height and the bigger the print area.

I think I have the macros set up, I just need to find out a way of monitoring the number of rows being used and run the macro as and when required.

Now, I have this setup in a cell that is outside of the print area:

Code: 
=COUNTIF(E14:E50,"*")

This counts any text in the rows in question and the formula therefore returns a number.

If this formula returns any value less than or equal to 20, I want a macro to run that adjusts the rows as necessary.

Then for every increase to 21,22,23,24.... up to 34, I want a macro to run for each number that adjusts the row sizes and sets the print area.

I thought I had it all set up but it doesn't appear to work. BB52 is the location of the COUNTIF formula above:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("BB52")) Is Nothing Then
    
        Select Case Target.Value
        
        Case Is = "21":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 19.75
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D37:AQ37").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$37"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "22":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 19
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D38:AQ38").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$38"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "23":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 18.25
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D39:AQ39").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$39"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "24":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 17.5
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D40:AQ40").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$40"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "25":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 16.75
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D41:AQ41").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$41"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "26":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 16.25
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D42:AQ42").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$42"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "27":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 16
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D43:AQ43").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$43"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "28":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 15.25
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D44:AQ44").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$44"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "29":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 14.75
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D45:AQ45").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$45"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "30":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 14.5
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D46:AQ46").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$46"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "31":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 14
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D47:AQ47").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$47"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "32":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 13.75
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D48:AQ48").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$48"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "33":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 13
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D49:AQ49").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$49"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "34":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 12.75
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
            .Borders (xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$50"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "35":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 12.75
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
            .Borders (xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$50"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "36":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 12.75
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
            .Borders (xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$50"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Is = "37":
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 12.75
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
            .Borders (xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$50"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        Case Else:
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        Rows("14:50").RowHeight = 20.5
        With Range("D36:AQ50").Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("D36:AQ36").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick
        End With
        ActiveSheet.PageSetup.PrintArea = "$D$5:$AQ$36"
        ActiveSheet.Protect
        Application.ScreenUpdating = True
        
        End Select
        
    End If

End Sub

Can anyone suggest why this doesn't work?

I've tried some test data to increase the formula result up to 34, but nothing changes.

Thanks for any help,
Liam
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Without going through your code, can I ask when you think this macro will be triggered? And what you think Target will be?

I'd probably do something in the Worksheet_Calculate event if I wanted to do something dependent on a calculated value ... maybe. ( depends on how much processing was needed and whether that slowed the response time of the sheet down too much )
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
331
RoryA
RoryA
P
  • Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
187
6StringJazzer
6StringJazzer
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
861
kerm007
K
G
  • Solved
Still no solution after 1 Year - Please Help
2
Replies
10
Views
365
jolivanes
jolivanes
J
  • Question
VBA Code to Add Rows is slowing down
Replies
5
Views
504
JayB0730
J

Forum statistics

Threads
1,214,915
Messages
6,122,217
Members
449,074
Latest member
cancansova

Share this page

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
Back
Top