My original VBA code worked. Then I added another and it stopped. How can I make them both work? This is what I have. The first one works but now the second one stopped.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim TargetWidth As Single, PossNewRowHeight As Single
    If Target.MergeCells Then
      With Target.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                TargetWidth = Target.ColumnWidth
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = TargetWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                  CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
Application.ScreenUpdating = True
End Sub

This is what I want to add. Was working previously.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$E$19" Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & vbNewLine & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

My original VBA code worked. Then I added another and it stopped. How can I make them both work? This is what I have. The first one works but now the second one stopped.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim TargetWidth As Single, PossNewRowHeight As Single
    If Target.MergeCells Then
      With Target.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                TargetWidth = Target.ColumnWidth
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = TargetWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                  CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
Application.ScreenUpdating = True
End Sub

This is what I want to add. Was working previously.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$E$19" Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & vbNewLine & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

• excel
• vba

• 1 You can only have one Worksheet_Change event handler in a sheet module. So the logic needs combined (directly or indirectly). – BigBen Commented yesterday
• Could you tell me how to do that. I don't know how to code. I go both of these off of the internet. Any help would be appreciated. – Ginny Commented yesterday
• Rename the second Worksheet_Change to (eg) CheckList and call it from the first Worksheet_Change like CheckList Target Probably best to run that first before performing the resize. – Tim Williams Commented yesterday
• Apologies, I have zero coding experience. You lost me at the call it from the first Worksheet_Change. I don't know what that means. Can you show me? – Ginny Commented yesterday
• 1 Insert the line CheckList Target in the first code block, immediately before the line If Target.MergeCells Then – Tim Williams Commented yesterday

1 Answer 1

If you want to do multiple things triggered by a worksheet change, it's cleaner to put each thing in its own method and call each of them from the change event:

Private Sub Worksheet_Change(ByVal Target As Range)
    CheckListEntry Target
    CheckMerged Target
End Sub

Private Sub CheckMerged(Target As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim TargetWidth As Single, PossNewRowHeight As Single
    
    'CheckListEntry Target '<<<< left by mistake: delete/comment out
    
    If Target.MergeCells Then
      With Target.MergeArea
            If .Rows.count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                TargetWidth = Target.ColumnWidth
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = TargetWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                  CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
    Application.ScreenUpdating = True
End Sub


Private Sub CheckListEntry(ByVal Target As Range)
    Dim Oldvalue As String, Newvalue As String
    
    On Error GoTo haveError 'ensure events are not left disabled
    
    'couple of checks...
    If Target.Address <> "$E$19" Then Exit Sub
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub
    
    Newvalue = Target.Value
    If Len(Target.Value) = 0 Then Exit Sub 'cell is empty
    
    Application.EnableEvents = False
    Application.Undo
    Oldvalue = Target.Value
    
    If Oldvalue = "" Then
        Target.Value = Newvalue
    Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & vbNewLine & Newvalue
        Else
            Target.Value = Oldvalue
        End If
    End If
       
haveError:
    Application.EnableEvents = True
End Sub