Figuring Out the Multiple Worksheet Change Function-CodePudding

I've read through a bunch of similar questions, but I'm honestly not quite understanding the solution. I've changed the code, and essentially seem to have broken it even more.

Expectation: When the data in the E column is changed, the L and M columns will erase themselves. Additionally, if the F column = "DFW" then it will copy/paste the row to the DFW sheet, and then delete and move up the original row from Sheet1.

Current Result: Nothing happening. Before I added the If Nots (which were suggested in previous posts), I would get the functions to work once, but it would have a weird hangtime but work once. After that, I'd have to restart the spreadsheet to get everything to function again.

Bonus: If there is also a way to auto sort based on column N (oldest to newest) and then sub sort based on column A (A to Z). Essentially organize by date, and then those entries organized alphabetically.

Thanks in advance for any help!

Sub Worksheet_Change(ByVal Target As Range)
Dim tbl As ListObject
Dim i As Long
'   Exit if more than one cell updated
'    If Target.CountLarge > 1 Then Exit Sub
'   Check to see if row > 1 and value is "Yes"
'    If (Target.Row > 2) And (Target.Value = "DFW") Then
If Not Intersect(Target, Range("F:F")) Is Nothing Then
    If Target.Value = "DFW" Then
'       Set tbl to new table
        Set tbl = Sheets("DFW").ListObjects("Tasks7835")
'       Add row
        tbl.ListRows.Add , 1
'       set i to rowcount of table
        i = tbl.ListRows.Count
'       copy values
        tbl.DataBodyRange(i, 1).Resize(1, 20).Value = Range("A" & Target.Row).Resize(1, 20).Value
        Application.EnableEvents = False
'       Delete old row
        Target.EntireRow.Delete Shift:=xlUp
        Application.EnableEvents = True
        Exit Sub
End If
'    If Target.Cells.Count > 1 Then Exit Sub

'    If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
If Not Intersect(Target, Range("E:E")) Is Nothing Then
    Application.EnableEvents = False
    If Target = vbNullString Then
        Target.Offset(0, 7) = vbNullString
        Target.Offset(0, 8) = vbNullString
    Else
        Target.Offset(0, 7) = ""
        Target.Offset(0, 8) = ""
End If

On Error GoTo 0

End Sub

CodePudding user response：

Try this code:

Option Explicit

Sub Worksheet_Change(ByVal Target As Range)
    Dim TCELL As Range

    On Error GoTo out
    Application.EnableEvents = False
    
    Set TCELL = Intersect(Target, Me.Columns("F"))
    If Not TCELL Is Nothing Then
        Set TCELL = TCELL(1)    ' get only first cell from Target
        If UCase(TCELL) = "DFW" Then
            ThisWorkbook.Sheets("DFW").ListObjects("Tasks7835") _
                .ListRows.Add(, True).Range.Resize(1, 20).Value = _
                Me.Range("A" & TCELL.Row).Resize(1, 20).Value
            TCELL.EntireRow.Delete
        End If
    Else
        Set TCELL = Intersect(Target, Me.Columns("E"))
        If Not TCELL Is Nothing Then
            Set TCELL = TCELL(1) ' get only first cell from Target
            If TCELL = vbNullString Then _
                TCELL.Offset(0, 7).Resize(, 2) = vbNullString
        End If
    End If
out:
    Application.EnableEvents = True
End Sub

The original code was almost workable. It was missing two End If. Also, Application.EnableEvents = True was omitted from the second part of the procedure. I also removed some redundant commands such as On Error GoTo 0, Target.Offset(0, 7) = "", i = tbl.ListRows.Count. In addition, I introduced a TCELL variable containing one cell (Target can contain multiple cells and in this case throw an error when executing If Target.Value = ... Then)

CodePudding user response：

A Worksheet Change: Backup Before Delete

Option Explicit

Sub Worksheet_Change(ByVal Target As Range)
    
    Const FirstRow As Long = 2
    
    Dim srg As Range
    Dim irg As Range
    
    Set srg = Me.Columns("E").Resize(Me.Rows.Count - FirstRow   1)
    Set irg = Intersect(srg, Target)
    
    If Not irg Is Nothing Then
        Application.EnableEvents = False
            Intersect(irg.EntireRow, Me.Columns("L:M")).ClearContents
        Application.EnableEvents = True
        Set irg = Nothing
    End If
    
    Set srg = Me.Columns("F").Resize(Me.Rows.Count - FirstRow   1)
    Set irg = Intersect(srg, Target)
    
    If Not irg Is Nothing Then
        
        Dim tbl As ListObject
        Set tbl = Me.Parent.Worksheets("DFW").ListObjects("Tasks7835")
        
        Dim drg As Range
        Dim iCell As Range
        Dim lr As ListRow
        
        For Each iCell In irg.Cells
            If CStr(iCell.Value) = "DFW" Then
                Set lr = tbl.ListRows.Add(, True)
                lr.Range.Resize(, 20).Value = iCell.EntireRow.Resize(, 20).Value
                If drg Is Nothing Then
                    Set drg = iCell
                Else
                    Set drg = Union(drg, iCell)
                End If
            End If
        Next iCell
        
        If Not drg Is Nothing Then
            Application.EnableEvents = False
                drg.EntireRow.Delete xlShiftUp
            Application.EnableEvents = True
        End If
    
    End If
    
End Sub