Sub ShrinkColumns()
Dim x As Integer, wait As Double, go As Double
Dim ColWide
'(Change to the column(s) of choice and/or set to how wide your columns are)
ColWide = Columns("B:C").ColumnWidth
For x = ColWide To 0.1 Step -1
With Columns("B:C")
.ColumnWidth = x
wait = 0.005
go = Timer
Do While Timer - go < wait
Loop
End With
Next x
End Sub
Sub GrowColumns()
Dim x As Integer, wait As Double, go As Double
For x = 0.1 To 15 '(Set to how wide you want the columns to get)
With Columns("B:C") 'Change to the column(s) of choice
.ColumnWidth = x
wait = 0.005
go = Timer
Do While Timer - go < wait
Loop
End With
Next x
End Sub