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 :thumb


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.