1

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
VBasic2008
  • 44,888
  • 5
  • 17
  • 28

2 Answers2

1

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
            TCELL(1).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)

Алексей Р
  • 7,507
  • 2
  • 7
  • 18
  • This didn't reset columns L and M if E was changed – Brandon DeAvilla Sep 01 '22 at 23:59
  • @BrandonDeAvilla If you need to clear the cells of column L and M for any change in E, then you just need to remove the condition `If TCELL = vbNullString Then`. Removed. – Алексей Р Sep 02 '22 at 02:12
  • Works like a charm! Only issue that I'm running into is that the contents of the K column and T column contain formulas, and the formulas aren't carrying over to the new sheet, just the last value that was output. Any way around this? – Brandon DeAvilla Sep 05 '22 at 18:30
  • Try to use `.Formula` or `.FormulaR1C1` instead of `.Value` inside `If UCase(TCELL) = "DFW" Then` block. Please note that copying formulas to another location may break links and cause calculation errors – Алексей Р Sep 05 '22 at 19:13
  • This worked perfectly! The formula I'm utilizing is just a day countdown, and it appears to be adjusting as needed!| Thank you for the assistance! – Brandon DeAvilla Sep 05 '22 at 20:34
1

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
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • This works about 99% of the way! The only issue I am seeing is when it is copying from one sheet to another, it is copying texts and not the formulas within the cells. Is there a way to adjust this code to allow it to copy the contents of the cell and not just the output of some formulas? – Brandon DeAvilla Sep 01 '22 at 23:49
  • Also, is there a way to make it so when moving item to the new table, that it shifts down and adds at the very top of the table, instead of the bottom of the table? – Brandon DeAvilla Sep 02 '22 at 01:06
  • Try: `Set lr = tbl.ListRows.Add(1, True)` and `iCell.EntireRow.Resize(, 20).Copy lr.Range.Resize(, 20)`. – VBasic2008 Sep 02 '22 at 07:50
  • Still carrying over text values and not formulas contained within the cells – Brandon DeAvilla Sep 02 '22 at 17:09
  • Just following up. Any other suggestions to copy the formula within the cell and not just the output of the formula ? – Brandon DeAvilla Sep 04 '22 at 14:50