Dropdown List Copy/Paste to Excel Table on Different Worksheet But in Wrong Column

[rorobear]

Hello Everyone,

First, to be compliant with forum rules i also have posted this request on Excel Forum, but haven't received any help. Hoping
someone can please assist.

https://www.excelforum.com/excel-programming-vba-macros/1401480-dropdown-list-copy-paste-to-excel-table-on-different-worksheet-but-in-wrong-column.html

Here is the layout:
Workbook with 2 worksheets (?Budget Plan_FY2023? and ?Not Required Items?)
One table on each sheet (?BudgetPlan? and ?NotRequired?)
Columns M, P, S and V on the ?Budget Plan_FY2023? sheet contains dropdowns and when the words ?Not Required? is selected from any of the dropdowns,
the entire row is deleted and pasted to the ?NotRequired? table on the ?Not Required Items? sheet. It works, except I have one problem.
The data is pasted starting in column C, but the data should paste starting in column B.
Workbook is attached, any assistance is greatly appreciated.

 Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Set rng = Union(Range("M:M"), Range("P:P"), Range("S:S"), Range("V:V")) ' Define the range to monitor for changes

    If Not Intersect(Target, rng) Is Nothing Then ' Check if the changed cell is in the monitored range

        Application.EnableEvents = False ' Disable event handling to prevent infinite loops

        For Each cell In Intersect(Target, rng) ' Loop through all changed cells
            Select Case cell.Value ' Check the value of the cell and change the interior color accordingly

                Case "Funded"
                    cell.Interior.Color = RGB(169, 208, 142) '< ---Green

                Case "Unfunded"
                    cell.Interior.Color = RGB(254, 168, 174) '<---Red

                Case "Awaiting Approval"
                    cell.Interior.Color = RGB(255, 255, 0) '<---yellow

                Case Else
                    cell.Interior.Color = RGB(255, 255, 255) ' Reset the cell interior color to white

            End Select


            cell.Offset(0, -2).Interior.Color = cell.Interior.Color ' Set the same color in column K

            ' Check if the cell contains "Not Required" and delete the row and paste it in the "FY23_NotRequired" table on Sheet2
            If InStr(1, LCase(cell.Value), "not required") > 0 Then
                Application.ScreenUpdating = False
                Application.EnableEvents = False
                
                Dim tbl As ListObject
                Set tbl = Worksheets("not required items").ListObjects("NotRequired")
'                tbl.ListRows.Add
                tbl.ListRows.Add.Range.Value = cell.EntireRow.Value

                Application.ScreenUpdating = True
                Application.EnableEvents = True
                ActiveSheet.Rows(cell.Row).Delete
            End If

        Next cell

        Application.EnableEvents = True ' Re-enable event handling

    End If

End Sub

[June7]

Have you considered just applying filter to not display "not required" items on BudgetPlan sheet?

I expect that cell.EntireRow.Value is including column A. I tested by deleting both columns A and modifying code for cell references. Works.

[Paul_Hossler]

First, to be compliant with forum rules i also have posted this request on Excel Forum, but haven't received any help. Hoping
someone can please assist.

We like that


I'm not very good with tables, but try this

              Dim tbl As ListObject
                Dim r1 As Range
                Set tbl = Worksheets("not required items").ListObjects("NotRequired")
                Set r1 = cell.EntireRow
                Set r1 = r1.Cells(1, 2).Resize(1, 22)
                
                tbl.ListRows.Add
                r1.Copy tbl.Range.Rows(tbl.Range.Rows.Count)

[rorobear]

i did try delete column A and modifying this line of code: tbl.ListRows.Add.Range.Value = cell.EntireRow.Value. only to receive error after error, hence why i came here to the experts.

[rorobear]

YES!!! that did the trick. thank you, sir!!!

[June7]

The only edit to code I did was for Set rng line:

Set rng = Union(Range("L:L"), Range("O:O"), Range("R:R"), Range("U:U")) ' Define the range to monitor for changes

But Paul's change certainly makes sense without having to modify sheets.

Glad you have solution.

[rorobear]

yes, indeed! thank you very much i really appreciate the support.