Find the cell in a row with the most charaters

[ecivon]

Hi all,

I have a spreadsheet which has merged cells and an autoheight issue. I know this is a bad idea and have tried to rework the spreadsheet to avoid the use of merged cells but it cannot be helped.
I have implemented a version of Jim Reich's code to resolve the auto height issue, with protection issues resolved too.
Basically, it now works as it was intended.

The issue is that the code runs on every merged cell in a row. So if the first cell has lots a characters in it, the row is resized to fit. But if the next row has only a few characters, the row resizes again to fit the smaller row, cutting off text on the larger cell from view.

Therefore, I want a simple bit of code at the start of this process to check the number of characters of each cell in the current row. If the current cell has less characters than any other cell in the current row then do not run the autoheight code. If it has the most characters in a cell in the current row then run the autoheight code.

Sounds simple enough but as a vba novice I have no clue where to start.

I am running excel 2007.
The autoheight code that is being run is included below.

Thanks in advance for any help.

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
ma.Locked = False
Application.ScreenUpdating = True
End If
End With
ActiveSheet.Protect
End Sub

 

[Andrew Poulsom]

Try incorporating this:

    Dim LastCol As Long
    Dim Addr As String
    Dim MaxLen As Long
    With Target.Cells(1, 1)
        LastCol = Cells(.Row, Columns.Count).End(xlToLeft).Column
        Addr = Range(Cells(.Row, 1), Cells(.Row, LastCol)).Address(False, False)
        MaxLen = Evaluate("=MAX(LEN(" & Addr & "))")
        If Len(.Value) < MaxLen Then Exit Sub
    End With

 

[ecivon]

That is absolutely perfect. Thank you very much.