Excel VBA Column Width - Merged Cells

[ststern45]

Hi everyone,
I need help with VBA code.
I would like to re-size the columns H through M based on the maximum number of characters (numbers & dashes) in each cells
For example column H there are 30 cells that may range anywhere from 6 to 24 characters in each cell.
Problem is cell range H7 through M7 and H8 through M8 are merged cells.
If I run the current macro it defaults to width of 8 due to the merged cells (H7 through M7 and H8 through M8)
Column M is the last column
All columns H through M have a column width of 8

Column H
Selection.ColumnWidth = 20

Column i
Selection.ColumnWidth = 16

Column j
Selection.ColumnWidth = 12

Column k
Selection.ColumnWidth = 12

Column l
Selection.ColumnWidth = 10

Column m
Selection.ColumnWidth = 8

Thank you in advance

 

[Joe4]

Just another example of why merged cells are so bad and should be avoided, if all possible!
i think the problem goes away if you convert those merged cells to "Center Across Selection" formatting option instead.
See: Tom’s Tutorials For Excel: Using Center Across Selection Instead of Merging Cells – Tom Urtis

 

[Joe4]

The only other way I can think of is to focus in on just the rows you want to consider, find the maximum length of those cells, and then set the column to be that wide.
For example, if we only wanted to consider rows 9 through 39 for columns H through M, that code might look something like this:

First, we will create a custom Function that will find the maximum length in any range of cells:

Function MaxCellWidth(rng As Range) As Long
'   Get the maximum length on entry in a range of cells

    Dim cell As Range
    Dim w As Long
    
'   Loop through all cells and return longest width
    For Each cell In rng
        If Len(cell) > w Then w = Len(cell)
    Next cell
    
'   Return width
    MaxCellWidth = w
    
End Function

Then, we have our code which goes through those columns, uses the function above to find the max length, and then set that column width:

Sub SetColWidths()

    Dim fr As Long
    Dim lr As Long
    Dim fc As Long
    Dim lc As Long
    Dim c As Long
    Dim rng As Range
    Dim w As Long
    
'   Set rows and columns to consider and re-size
    fr = 9  'first row (9)
    lr = 39 'last row (39)
    fc = 8  'first column ("H")
    lc = 13 'last column ("M")
    
'   Loop through all columns
    For c = fc To lc
'       Build range to check
        Set rng = Range(Cells(fr, c), Cells(lr, c))
'       Get max column width
        w = MaxCellWidth(rng)
'       Set column width
        Cells(1, c).EntireColumn.ColumnWidth = w
    Next c
    
End Sub

 

[ststern45]

Thank you for the code and suggestions.
I used Tom's suggestion and the code worked.

 

[Joe4]

You are welcome.
Glad I was able to help!