Expand column width automatically based on drop down selection

[Shadkng]

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

 

[Shadkng]

Thanks for the answers I will try them out.

However, I don't understand something which I probably should. I have been using the activeX combo boxes on existing data validation lists. But I see you can create the same combo box without data validation and specify the list range in the properties. So why would you use a combo "with" the same list as a data validation? Are there advantages?

Also, I plan revise some of my existing data validation lists to dependent ones. Is it possible to to dependent lists just with combo lists? Maybe I should change my data validation lists to only combo?

I have searched online for some of these answers and haven't found a clear explanation. Most of the explanations for combo boxes are with data validation lists.

Thanks

 

[Akuini]

Actually I don't like the combination of data validation & combobox. It is in your original code so I thought that is what you want.
I prefer combobox than data validation. The one that I like is the combobox that has 2 special behavior:
1. The combobox can appear and hide automatically when you select a cell in a certain range.
2. You can type a keyword in the combobox and the results will be narrowed down as you type.
you can see the screenshot in another thread here:

https://www.mrexcel.com/forum/excel...fset-help-please-post5221389.html#post5221389

As for dependent lists, do you mean you want 2 combobox where 1 combobox list is dependent to the other?
Yes, that can be done too using vba.

 

[Shadkng]

OK, so I have many many drop downs in my sheet. With combo and data validation I just create one combo and it works on all drop downs. So if I use just combo then I have to create one for each list?

The answer is yes for the dependent lists - one combo dependent on the other.

I just learned online how to do dependents for data validation with the "indirect". Is it complicated to to it with only combo? I just a beginner with VBA and my more advance scripts have been written by guys like you!

 

[Shadkng]

OK, so I have many many drop downs in my sheet. With combo and data validation I just create one combo and it works on all drop downs. So if I use just combo then I have to create one for each list?

The answer is yes for the dependent lists - one combo dependent on the other.

I just learned online how to do dependents for data validation with the "indirect". Is it complicated to to it with only combo? I just a beginner with VBA and my more advance scripts have been written by guys like you!

One more thing I didn't mention - I need the drop down in rows that I copy down, so it seems I would need data valid for that. On my sheet on enter data in row 24 and then copy down sometime hundreds of rows and change the data on some of the cells. The combo boxes are kind of floating?

 

[Akuini]

I need the drop down in rows that I copy down, so it seems I would need data valid for that. On my sheet on enter data in row 24 and then copy down sometime hundreds of rows and change the data on some of the cells.

That can be done (by using data validation or combobox) but it certainly requires more code, you might want to start a new thread for that.

The combo boxes are kind of floating?

Yes

 

[Shadkng]

Ok I think I'll stick with the data validation with combo. I will check the code from your sheet to see if it improves mine. I'll be back to you for any additional help related to this thread. Thanks

 

[Shadkng]

1. It's possible via a code but by what event? Do you mean change event or clicking special button?
2. Sure, use Const FitColumns = "C:E" or even Const FitColumns = "A:ZZ".
3. Just rename one to Private Sub Worksheet_Change1(ByVal Target As Range) and call it from another one using this line of the code:
Call Worksheet_Change1(Target), like this:

Private Sub Worksheet_Change1(ByVal Target As Range)
  ' ... The code1 ...
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
  ' ... The code2 ...
  Call Worksheet_Change1(Target)
End Sub

I am not clear on your answer
2. Sure, use Const FitColumns = "C:E" or even Const FitColumns = "A:ZZ".

This code will expand the cell width if typed value in a cell is too wide? If yes, where do I put this code? In a separate worksheet_change? Or can I put it with the code that is using drop down autofit.

Thanks

 

[ZVI]

I am not clear on your answer
> 2. Sure, use Const FitColumns = "C:E" or even Const FitColumns = "A:ZZ".

This code will expand the cell width if typed value in a cell is too wide? If yes, where do I put this code? In a separate worksheet_change? Or can I put it with the code that is using drop down autofit.

Yes. In the code of the post 22 replace Const FitColumns = "C:D" by the suggested Const FitColumns = "C:E" and type long text into E24:E1000 to see how it works. Certainly, code of Worksheet_Change should be in the sheet's code module.

 

[Shadkng]

Hi Akuini, I am having a strange problem with the auto fit code from post#8. When I double click and use the combo box to choose a wide entry and then I click to another cell, the data in the clicked cell deletes. It doesn't happen when I select using data validation, only when using the combo. Below is all mt code in that sheet.

Also, can you check if I did the "call" change1" as you instructed above n post #47 . Thanks

Private Sub quotecombo_Change()
ActiveCell = QuoteCombo.Value
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet

Set cboTemp = ws.OLEObjects("QuoteCombo")
  On Error Resume Next
  With cboTemp
  'clear and hide the combo box
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    'if the cell contains
      'a data validation list
    Cancel = True
    Application.EnableEvents = False
    'get the data validation formula
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      'show the combobox with the list
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 15
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.QuoteCombo.DropDown
  End If
  
errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub
'=========================================
Private Sub QuoteCombo_LostFocus()
  With Me.QuoteCombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub


Private Sub Worksheet_Change1(ByVal Target As Range)
If Not Intersect(Target, Range("C24:C1000")) Is Nothing And ActiveSheet.Range("B3") <> 1 And Target.Cells.Count = 1 Then
    If UCase(Target) Like "GAL*" Or UCase(Target) Like "SA-36*" Or UCase(Target) Like "SA-45*" Then
         response = MsgBox("YOU MAY NEED CONTINUOUS CHAIN. SELECT *YES* TO STOP FUTURE WARNINGS OR *NO* TO CONTINUE WARNINGS.", vbYesNo)
        If response = vbYes Then
    ActiveSheet.Range("B3") = 1
Else
    Exit Sub
End If
    End If
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
        'change the range address to suit
    If Not Intersect(Target, Range("B24:D1000,Y24:Z1000,AF24:AF1000,AZ24:AZ1000,BD24:BD1000,BF24:BS1000")) Is Nothing Then
        Dim x As Double
        If Target.Cells.Count = 1 Then
            x = Target.Columns.ColumnWidth
            Target.Columns.AutoFit
            If Target.Columns.ColumnWidth < x Then Target.Columns.ColumnWidth = x
            
            'minimum width, change to suit
            If Target.Columns.ColumnWidth < 18 Then Target.Columns.ColumnWidth = 18
    End If
    End If[COLOR=#ff0000]
   [B] Call Worksheet_Change1(Target)[/B][/COLOR]
    End Sub

 

[ZVI]

Delete quotecombo_Change.
You may try this edition of the code:

Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
  Dim s As String ' str is not good for a name of variable because Str() is the internal VBA function
  Dim cboTemp As ComboBox
  Set cboTemp = Me.QuoteCombo
  On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    'if the cell contains
    'a data validation list
    Cancel = True
    Application.EnableEvents = False
    'get the data validation formula
    s = Target.Validation.Formula1
    s = Mid(s, 2)
    With cboTemp
      'show the combobox with the list
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 15
      .Height = Target.Height + 5
      .ListFillRange = s
      .LinkedCell = Target.Address
      .Visible = True
    End With
    cboTemp.Activate
    'open the drop down list automatically
    cboTemp.DropDown
  End If
 
errHandler:
  Application.EnableEvents = True
 
End Sub
 
Private Sub QuoteCombo_LostFocus()
  On Error Resume Next
  With Me.QuoteCombo
    .Visible = False
    Call Worksheet_Change(Range(.LinkedCell))
    .LinkedCell = ""
    .ListFillRange = ""
    .Value = ""
  End With
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
  '--> Setting, change to suit
  Const RangeToFit = "B24:D10000,Y24:Z10000,AF24:AF10000,AZ24:AZ10000,BD24:BD10000,BF24:BS10000"
  '<--
 
  ' See the post 38, this code solves issue of a column size fitting when:
  '  1. Not active cell below the row 23 in active column has a lengthy text (minimun width is not enough)
  '  2. Width of active column is less than it's required for the point 1 (being resized manually, for example)
  '  3. Length of a text in active cell is less than lenght of the cell in point 1
  ' Also this code auto resizes a series of columns at deleting/copying group of cells
  Dim OldWidth As Double, Col As Range
  If Intersect(Target, Range(RangeToFit)) Is Nothing Then Exit Sub
  For Each Col In Intersect(Target.EntireColumn, Range(RangeToFit)).Columns
    OldWidth = Col.ColumnWidth
    Col.AutoFit
    If Col.ColumnWidth < OldWidth Then Col.ColumnWidth = OldWidth
    If Col.ColumnWidth < 18 Then Col.ColumnWidth = 18
  Next
 
  ' Other code
  Dim response
  If Not Intersect(Target, Range("C24:C1000")) Is Nothing And ActiveSheet.Range("B3") <> 1 And Target.Cells.Count = 1 Then
    If UCase(Target) Like "GAL*" Or UCase(Target) Like "SA-36*" Or UCase(Target) Like "SA-45*" Then
      response = MsgBox("YOU MAY NEED CONTINUOUS CHAIN. SELECT *YES* TO STOP FUTURE WARNINGS OR *NO* TO CONTINUE WARNINGS.", vbYesNo)
      If response = vbYes Then
        ActiveSheet.Range("B3") = 1
      Else
        Exit Sub
      End If
    End If
  End If
 
End Sub