changing column widths by selecting cell in that column

[keithmct]

I have 10 columns which don't fit across my screen. How can I have the width small when not using that column, then as I click/type anywhere in the column it increases in width only to reduce in width when one of the other columns is clicked or typed in?

 

[Saurabhj]

Hello,

use below code in Selection Change event of Worksheet. It will autofit the column according to the cell you are working. Not sure if it fulfils the requirement.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim totalColumns As Integer, colno As Integer
    totalColumns = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Columns.ColumnWidth = 10
    Target.Columns.AutoFit
End Sub

 

[Peter_SSs]

Possibly this would suffice?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.UsedRange.ColumnWidth = 10
    Target.EntireColumn.AutoFit
End Sub

 

[keithmct]

Possibly this would suffice?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.UsedRange.ColumnWidth = 10
    Target.EntireColumn.AutoFit
End Sub

not quite. I didn't account for some of my columns being different widths and must remain so. I'll have to think about it some more before asking more questions, thanks anyway.

 

[Peter_SSs]

I didn't account for some of my columns being different widths and must remain so.

Would this be better, assuming 10 columns as mentioned originally?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim myWidths As Variant
  Dim i As Long
  
  myWidths = Split("5 12 5 5 4 3 7 5 7 7")  '<- These are the 'normal' column widths
  Application.ScreenUpdating = False
  For i = 0 To UBound(myWidths)
    Columns(i + 1).ColumnWidth = myWidths(i)
  Next i
  Target.EntireColumn.AutoFit
  Application.ScreenUpdating = True
End Sub

 

[keithmct]

Would this be better, assuming 10 columns as mentioned originally?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim myWidths As Variant
  Dim i As Long
 
  myWidths = Split("5 12 5 5 4 3 7 5 7 7")  '<- These are the 'normal' column widths
  Application.ScreenUpdating = False
  For i = 0 To UBound(myWidths)
    Columns(i + 1).ColumnWidth = myWidths(i)
  Next i
  Target.EntireColumn.AutoFit
  Application.ScreenUpdating = True
End Sub

so close. I changed it a bit as follows

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim myWidths As Variant
  Dim i As Long
 
  myWidths = Split("10 25 0.4 10 25 0.4 10 25 0.4 10 25 0.4 10 25 0.4")  '<- These are the 'normal' column widths
  Application.ScreenUpdating = False
  For i = 0 To UBound(myWidths)
    Columns(i + 1).ColumnWidth = myWidths(i)
  Next i
  Target.ColumnWidth = 40
  Application.ScreenUpdating = True
End Sub

the columns that are 10 width are just for input of an appointment time and never need to change & I would prefer they didn't change width. The 0.4 ones are just dividers and also will never be clicked on. Otherwise it works perfectly. Having said that, this is a 265 sheet appointment diary so I need to get the code to work on all sheets. Do I put the code in This Workbook?
I would like to post xl2BB here but now if I select a section the columns all go to 40 wide. here is another sheet without the code if that helps. disregard the cell formulas

column change width experiment.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
2		STEVE			RICKY			LUKE				ELI
3		Tuesday, 4 January 2022			Tuesday, 4 January 2022			Tuesday, 4 January 2022				Tuesday, 4 January 2022
4	time	details		time	details		time	details			time	details
5	you need -			you need -			you need -				you need -
6
7	8.30	VGNMCGHM zdfhsdghdsh zdfdfbzdgbzdbz
8		CHNCVHM
9		VBNCVN
10
11
12
13
14	9.30	VBNCVBN
15
16
17
18	10.30	CVBNCVNCVN
19
20	11.00	XBVCNCVBNCV
21
22
Tuesday 04 Jan 2022

Cell Formulas
Range	Formula
B3	B3	=A1
E3	E3	=+A1
H3	H3	=A1
L3	L3	=A1

 

[Peter_SSs]

I am gathering that you really only want/need this to work when a single cell is selected?
I have assumed that for now anyway.
Remove any Worksheet_Change event codes dealing with this issues from sheet modules and place this in the ThisWorkbook module

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim myWidths As Variant
  Dim NumCols As Long, TargetCol As Long, i As Long
  
  If Target.CountLarge = 1 Then
    myWidths = Split("10 25 0.4 10 25 0.4 10 25 0.4 10 25 0.4 10 25 0.4")  '<- These are the 'normal' column widths
    NumCols = UBound(myWidths) + 1
    TargetCol = Target.Column
    Application.ScreenUpdating = False
    For i = 0 To NumCols - 1
      Columns(i + 1).ColumnWidth = myWidths(i)
    Next i
    If Target.Column <= NumCols Then
      If myWidths(TargetCol - 1) <> 0.4 And myWidths(TargetCol - 1) <> 10 Then Target.ColumnWidth = 40
    End If
    Application.ScreenUpdating = True
  End If
End Sub

 

[keithmct]

I am gathering that you really only want/need this to work when a single cell is selected?
I have assumed that for now anyway.
Remove any Worksheet_Change event codes dealing with this issues from sheet modules and place this in the ThisWorkbook module

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim myWidths As Variant
  Dim NumCols As Long, TargetCol As Long, i As Long
 
  If Target.CountLarge = 1 Then
    myWidths = Split("10 25 0.4 10 25 0.4 10 25 0.4 10 25 0.4 10 25 0.4")  '<- These are the 'normal' column widths
    NumCols = UBound(myWidths) + 1
    TargetCol = Target.Column
    Application.ScreenUpdating = False
    For i = 0 To NumCols - 1
      Columns(i + 1).ColumnWidth = myWidths(i)
    Next i
    If Target.Column <= NumCols Then
      If myWidths(TargetCol - 1) <> 0.4 And myWidths(TargetCol - 1) <> 10 Then Target.ColumnWidth = 40
    End If
    Application.ScreenUpdating = True
  End If
End Sub

you, Peter, are a legend. Thanks.

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.