VBA CODE in all rows

[jdlerry]

Hi, I need help with VBA Codes please.

I have attached a sample file through dropbox. eMedical-Tracker-new.xlsm

I will put all my data in Masterlist tab and under ACTION TAKEN/ TO DO, whenever I select an action from the dropdown, it should delete the entire row and move/copy to its destination tab. You may see the INSTRUCTION tab for reference.

The Masterlist will have multiple rows so it should not just be applicable to row 4.

I already placed the code in the Masterlist tab but the problem which I need help is it should not just be in row 4 but I have multiple rows in that sheet. How do I make that happen?

 

[Zot]

Hi @jdlerry ,

Looks like this is a modification requirement to my previous code. Since it is still quite fresh in my mind, it is easy to modify.

Here is the modification. When you make selection (change selection) in column O, then it will trigger the macro. The row with selection change will get deleted after the data on that row is transferred. Note that this will also shorten the row with drop-down selection. Hope this works.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strAction As String
Dim rngData As Range, rngAction As Range
Dim wsDest As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False

Set rngAction = Range("O4", Cells(Rows.Count, "O"))
On Error Resume Next
If Not Intersect(rngAction, Target) Is Nothing Then
    Set rngData = ActiveSheet.Range("A" & Target.Row, "V" & Target.Row)
    Select Case Target
        Case "FOR CASERVICEDESK"
            
        Case "TRIGGERED IN EDP"
        
        Case "REFER TO CON OFF"
            Set wsDest = Sheets("CON OFF")
            rngData.Copy
            wsDest.Range("A" & rowNext(wsDest)).PasteSpecial (xlPasteValues)
            rngData.EntireRow.Delete
        Case "TERM 1"
            Set wsDest = Sheets("TERM 1")
            rngData.Copy
            wsDest.Range("A" & rowNext(wsDest)).PasteSpecial (xlPasteValues)
            rngData.EntireRow.Delete
        Case "EMAIL SENT TO CST"
            Set wsDest = Sheets("EMAIL SENT TO CST")
            rngData.Copy
            wsDest.Range("A" & rowNext(wsDest)).PasteSpecial (xlPasteValues)
            rngData.EntireRow.Delete
        Case "FF-UP EMAIL SENT (CST)"
            Set wsDest = Sheets("FF-UP EMAIL SENT (CST)")
            rngData.Copy
            wsDest.Range("A" & rowNext(wsDest)).PasteSpecial (xlPasteValues)
            rngData.EntireRow.Delete
        Case "VERIFY WITH SLEC"
            Set wsDest = Sheets("VERIFY WITH SLEC")
            rngData.Copy
            wsDest.Range("A" & rowNext(wsDest)).PasteSpecial (xlPasteValues)
            rngData.EntireRow.Delete
        Case "RESOLVED"
            Set wsDest = Sheets("RESOLVED")
            rngData.Copy
            wsDest.Range("A" & rowNext(wsDest)).PasteSpecial (xlPasteValues)
            rngData.EntireRow.Delete
        Case "OTHERS, SEE REMARKS"
            Set wsDest = Sheets("OTHERS")
            rngData.Copy
            wsDest.Range("A" & rowNext(wsDest)).PasteSpecial (xlPasteValues)
            rngData.EntireRow.Delete
    End Select
End If
On Error GoTo 0
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Function rowNext(ws As Worksheet) As Long
rowNext = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
If rowNext < 4 Then rowNext = 4
End Function

 

[jdlerry]

HOW CAN I REPAY YOU?????! It works perfectly!!!!! Thank you sooo much.

 

[Zot]

HOW CAN I REPAY YOU?????! It works perfectly!!!!! Thank you sooo much.

No need to mention. the update from you whether it worked or not is suffice.