Expand column width automatically based on drop down selection

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
370
I'm having trouble finding code online that works to autofit a column width based on a selection in a drop down list. I would also like to have a minimum width that the column won't go below. I would need it for many columns in the same sheet so could it be a global type code? If not I can specify the column ranges and that would work. I am using combo drop downs as well if that matters. Thanks
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Try adding this to the sheet code that your working with, adjust to 1 or multiple columns.

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Columns("A:H").EntireColumn.AutoFit


End Sub
 
Upvote 0
Thanks need a little more help. I didn't realize I need it to start at row 24 and down to last row with data, so the data above 24 won't affect it.

Also, how can I specify several independent ranges?
 
Upvote 0
I maybe could help but do not understand.

Please explain what you want once more for me.

Realize also all cells in a column must be set to the same width.

You cannot auto fit rows(4) to (10) but not rows(1) to (3)
 
Last edited:
Upvote 0
OK I will explain better. My entries start in row 24 and down to a variable number of rows. I realize that the widest entry in the column from row 24 down will determine the column width. Some columns in my sheet have data above row 24 so I understand those entries, if wider, will determine the width. I do have merged cell above row 24 with "wrap text" so I don't know if that will be affected. When I tried the previous code on those columns they were getting wide on their own which was weird. I that's workable so far, could we also add some padding to the width so it's not so tight? Thanks
 
Upvote 0
I have no ideal how to do this. I will watch this thread and see what I can learn
 
Upvote 0
Maybe this:
Change the range address to suit

Code:
[FONT=lucida console][COLOR=Royalblue]Private[/COLOR] [COLOR=Royalblue]Sub[/COLOR] Worksheet_Change([COLOR=Royalblue]ByVal[/COLOR] Target [COLOR=Royalblue]As[/COLOR] Range)
        [I][COLOR=seagreen]'change the range address to suit[/COLOR][/I]
    [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] Intersect(Target, Range([COLOR=brown]"A24:B1000,D24:E1000"[/COLOR])) [COLOR=Royalblue]Is[/COLOR] [COLOR=Royalblue]Nothing[/COLOR] [COLOR=Royalblue]Then[/COLOR]
        [COLOR=Royalblue]Dim[/COLOR] x [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Double[/COLOR]
        [COLOR=Royalblue]If[/COLOR] Target.Cells.Count = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]Then[/COLOR]
            x = Target.Columns.ColumnWidth
            Target.Columns.AutoFit
            [COLOR=Royalblue]If[/COLOR] Target.Columns.ColumnWidth < x [COLOR=Royalblue]Then[/COLOR] Target.Columns.ColumnWidth = x
            
            [I][COLOR=seagreen]'minimum width, change to suit[/COLOR][/I]
            [COLOR=Royalblue]If[/COLOR] Target.Columns.ColumnWidth < [COLOR=crimson]15[/COLOR] [COLOR=Royalblue]Then[/COLOR] Target.Columns.ColumnWidth = [COLOR=crimson]15[/COLOR]
       
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR]
[/FONT]
 
  • Like
Reactions: ZVI
Upvote 0
Hi,
This code autofits widths of the defined columns by data stored in row 24 and the below rows.
Rich (BB code):
Sub AutoFitColumns()
 
  '--> Settings, change to suit
  Const FitColumns = "A:E"  ' Columns to fit
  Const FirstDataRow = 24   ' Fit data are in that row and the below rows
  '<--End of the settings
 
  Dim a() As Variant, Col As Range, LastDataRow As Long, Sh As Worksheet
 
  Set Sh = ActiveSheet
 
  Application.EnableEvents = False
  Application.ScreenUpdating = False
 
  With Intersect(Sh.UsedRange, Sh.Range(FitColumns))
    LastDataRow = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                                          SearchDirection:=xlPrevious, SearchFormat:=False).Row
    For Each Col In .Columns
      With Col.Resize(FirstDataRow - Col.Cells(1).Row)
        a() = .Value
        .Value = Empty
        .EntireColumn.AutoFit
        .Value = a()
      End With
    Next
  End With
 
  Application.EnableEvents = True
  Application.ScreenUpdating = True
 
End Sub
 
Last edited:
Upvote 0
Note: the LastDataRow is not used here - delete that variable and the code lines with it.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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