rorobear
03-11-2023, 03:31 PM
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
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