Auto-resize row

L

liampog

Active Member
Joined
Aug 3, 2010
Messages
316
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

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
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

K
  • Solved
formating question
Replies
3
Views
324
Micron
M
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
594
RoryA
RoryA
P
  • Question Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
378
6StringJazzer
6StringJazzer
R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
161
Joe4
Joe4
K
  • Question Question
VBA DOUBT- can we add heading color and remove blank columns in this code?
Replies
0
Views
168
Kishore1982
K

Forum statistics

Threads
1,224,587
Messages
6,179,734
Members
452,939
Latest member
WCrawford

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