autofit column width with a minimum value

[cjcass]

Hi,

I have the following code in a macro that autofits a column's width...

Columns("C:C").EntireColumn.AutoFit

How can I adapt this so it autofits but won't reduce the column width below a value of 20..?

Rgds,
Chris

 

[VBA Geek]

Columns("C").AutoFit
Columns("C").ColumnWidth = Application.Max(20, Columns("C").ColumnWidth)

 

[cjcass]

Awesome!! works perfectly... thank you muchly and have a great christmas

 

[HarryS]

a fair bit of code about the topic that I have in case anyone wants it

' use like    AutoFitTidyBor , xlMedium, 3, rgbLightGreen,20
' or  like    AutoFitTidyBor "Sheet3", , 7
'
Sub AutoFitTidyBor(Optional WSN$ = "ASN", _
                   Optional Bw As XlBorderWeight = xlMedium, _
                   Optional HeaderRow% = 333, _
                   Optional EmptyColCol& = rgbLightBlue, _
                   Optional MaxColWidth% = 222)


    Dim Ci%, wSheet As Worksheet, TrLCol&, TrLRow&, ColEmpty As Boolean, UsingHeaderRow As Boolean
    
    Application.ScreenUpdating = False


    If WSN = "ASN" Then WSN = ActiveSheet.NAme  ' default to active sheet name
    
    Set wSheet = Sheets(WSN)
    '
    If wSheet.Cells(1, 1) = "" Then wSheet.Cells(1, 1) = "."  ' else used range starts at first used cell
    '
    ' tidy up old used range borders
    '
    wSheet.Cells.Borders.Weight = xlThin


    Dim ww$: ww = wSheet.UsedRange.Address    ' Address  find should correct  used range
   '
   ' but if it did not fix it  this will finnish fixing used range
    '
    With wSheet
        TrLCol = .Cells.Find("*", .Cells(1, 1), , , xlByColumns, xlPrevious).Column
        TrLRow = .Cells.Find("*", .Cells(1, 1), , , xlByRows, xlPrevious).Row
        While .UsedRange.Columns.Count > TrLCol
            .Columns(.UsedRange.Columns.Count).Delete
        Wend
        While .UsedRange.Rows.Count > TrLRow
            .Rows(.UsedRange.Rows.Count).Delete
        Wend


        With .UsedRange


            .Columns.ColumnWidth = 2
            .Columns.AutoFit
            .Borders.Weight = Bw
            '
            'Fix the columns
            '
            UsingHeaderRow = HeaderRow% <> 333
            
            For Ci = 1 To .Columns.Count
            If wSheet.Columns(Ci).ColumnWidth > MaxColWidth Then wSheet.Columns(Ci).ColumnWidth = MaxColWidth
            
            
            ColEmpty = wSheet.Cells(.Rows.Count, Ci).End(xlUp).Row = 1 And _
            (wSheet.Cells(1, Ci) = "" Or wSheet.Cells(1, Ci) = ".")
            
                If ColEmpty Then
                    If UsingHeaderRow Then  ' fill from header row down
                        Range(Cells(HeaderRow, Ci), Cells(.Rows.Count, Ci)).Interior.Color = EmptyColCol
                    Else  ' fill whole used column
                        .Columns(Ci).Interior.Color = EmptyColCol
                    End If
                Else   ' column has data
                    If UsingHeaderRow Then  ' use header formats for the column
                        wSheet.Cells(HeaderRow, Ci).Copy
                        Range(Cells(HeaderRow, Ci), Cells(.Rows.Count, Ci)).PasteSpecial xlPasteFormats
                    End If
                End If
            Next Ci
            If UsingHeaderRow Then  '  header row  borders  thick
                Range(Cells(HeaderRow, 1), Cells(HeaderRow, .Columns.Count)).Borders.Weight = xlThick
            End If
        End With
    End With
    Application.ScreenUpdating = True
End Sub