+ Reply to Thread
Results 1 to 3 of 3

macro won't auto trigger on cell change

Hybrid View

  1. #1
    Registered User
    Join Date
    03-27-2013
    Location
    Brackley, England
    MS-Off Ver
    Excel 2003
    Posts
    14

    Cool macro won't auto trigger on cell change

    Afternoon,
    I have a spreadsheet with rows 20 - 34 having two merged columns B-E and F-J (I know nobody likes merged cells, but i need it to be this way as the people who are using the spreadsheets are proper novices and therefore rubbish at entering information correctly.)
    I have managed to cobble together a macro that auto adjusts the height of the columns to auto fit the text.
    This works by comparing the merged active cell text length LEN with the other in the same row and if it has more text then adjusts the height to fit. See the code that compares and trigger the actual resizing code below:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Const WS_RANGE As String = "B20:F34" '<<<< change to suit
    
    On Error GoTo ws_exit
    
    Application.EnableEvents = False
    
    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
    Dim LenValue As Integer
    Dim LenValuenext As Integer
    
    With Target
    'rhods bit
    LenValue = Len(ActiveCell)
    LenValuenext = Len(ActiveCell.Offset(0, 1))
    If LenValue > LenValuenext Then
    Call height
    Else: GoTo deadwood
    deadwood:
    End If
    
    'end of rhod's bit
    
    End With
    
    
    ws_exit:
    End If
    Application.EnableEvents = True
    End Sub
    and that triggers the code to actually do it.
    Sub height()
        Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
        Dim CurrCell As Range
        Dim ActiveCellWidth As Single, PossNewRowHeight As Single
        If ActiveCell.MergeCells Then
            With ActiveCell.MergeArea
                If .Rows.Count = 1 And .WrapText = True Then
                    Application.ScreenUpdating = False
                    CurrentRowHeight = .RowHeight
                    ActiveCellWidth = ActiveCell.ColumnWidth
                    For Each CurrCell In Selection
                        MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                    Next
                .MergeCells = False
                    .Cells(1).ColumnWidth = MergedCellRgWidth
                    .EntireRow.AutoFit
                    PossNewRowHeight = .RowHeight
                    .Cells(1).ColumnWidth = ActiveCellWidth
                    .MergeCells = True
                    '.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                    CurrentRowHeight, PossNewRowHeight)
                    .RowHeight = PossNewRowHeight + 3
                End If
            End With
        End If
    End Sub
    to get it to work I am having to trigger it from the worksheet_selectionchange. This only works when you click on the cell and not when you add/remove text.
    I have tried triggering from worksheet_change, but absolutly nothing happens (not when you type, not when you click.)

    does anyone know why and how to fix it? This is sending me absolutly mental.

    Thanks in advance.
    Last edited by rhodevans; 03-29-2013 at 12:51 PM. Reason: SOLVED

  2. #2
    Forum Guru Norie's Avatar
    Join Date
    02-02-2005
    Location
    Stirling, Scotland
    MS-Off Ver
    Microsoft Office 365
    Posts
    19,644

    Re: macro won't auto trigger on cell change

    Is the code actually being triggered?

    You can check that by putting a breakpoint on the first line with F9, and then goto the sheet and select something in the range you are monitoring.

    Another thing to check is that events are enabled, they might have been disabled at some point and not re-enabled.

    To do that goto the VBE, open the Immediate Window (CTRL+G) and enter this.
    ? Application.EnableEvents
    If that returns False events are disabled, re-enable them by entering this.
    Application.EnableEvents = True
    If posting code please use code tags, see here.

  3. #3
    Registered User
    Join Date
    03-27-2013
    Location
    Brackley, England
    MS-Off Ver
    Excel 2003
    Posts
    14

    Cool SOLVED!!! macro won't auto trigger on cell change

    Thanks very much for your help. The Adding break line helped me find out where the code was going wrong. I can't believe that I didn't know about this method until now!

    The issue with it was the fact that the code exceuted when return was hit, this meant that it was trying to resize the cell in the row below rather than the correct one.
    I have attached the correct trigger code, and the correct resize code below for anyone who needs it. Hope that it helps.

    Private Sub Worksheet_Change(ByVal Target As Range)
    Const WS_RANGE As String = "B20:F34" '<<<< change to suit
    
    On Error GoTo ws_exit
    
    Application.EnableEvents = True
    
    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
    Dim LenValue As Integer
    Dim LenValuenext As Integer
    
    With Target
    'rhods bit
    LenValue = Len(ActiveCell.Offset(-1, 0)) 'changed this line to compare the row above
    LenValuenext = Len(ActiveCell.Offset(-1, 1)) 'and this one too
    If LenValue > LenValuenext Then
    Call height
    Else: GoTo deadwood
    deadwood:
    End If
    
    'end of rhod's bit
    
    End With
    
    
    ws_exit:
    End If
    'Application.EnableEvents = True
    
    End Sub
    And the resize code

    
    Sub height()
        Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
        Dim CurrCell As Range
        Dim ActiveCellWidth As Single, PossNewRowHeight As Single
          If ActiveCell.MergeCells Then
            With ActiveCell.Offset(-1, 0).MergeArea 'changed this line to work on the one above
                If .Rows.Count = 1 And .WrapText = True Then
                    Application.ScreenUpdating = False
                    CurrentRowHeight = .RowHeight
                    ActiveCellWidth = ActiveCell.ColumnWidth
                    For Each CurrCell In Selection
                        MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                    Next
                .MergeCells = False
                    .Cells(1).ColumnWidth = MergedCellRgWidth
                    .EntireRow.AutoFit
                    PossNewRowHeight = .RowHeight
                    .Cells(1).ColumnWidth = ActiveCellWidth
                    .MergeCells = True
                    '.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                    CurrentRowHeight, PossNewRowHeight)
                    .RowHeight = PossNewRowHeight + 3 'added a bit of a buffer in here to make the cells more readable
                End If
            End With
        End If
    End Sub

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1