VBA - Transfer data to tab based on intials and then delete from tabs once date completed - Help

LanKez · Jan 27th 2020

Unfortunately this is not working - it doesn't transfer any data over to individual tabs and when I add something into the request from tab I receive end time debug warning - Am I missing something? thank you again for your help

Mumps · Jan 27th 2020

It works without errors for me. Are you trying the file I posted or are you using the macro on a different file?

LanKez · Jan 27th 2020

Hi

I am trying it on the file you provided and nothing moves over to the initial tabs.

I receive the below Debug warning

Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)

do I need to change anything, Any idea? Thanks again for your help

Kerry

Mumps · Jan 27th 2020

Are you getting that error when you make a selection in columns B, D or E of Workflow? When you make a selection in column P, does that row get copied to the sheet corresponding to the selection?

LanKez · Jan 28th 2020

I am getting the error when I try to put something In column B and then when I enter into row p and hit return it no longer transfers the data over to the separate initial tabs?? whereas before it would transfer over the data no problem

Mumps · Jan 28th 2020

Try:

Code

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:B,D:E,I:I,N:N,P:P")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim ID As Range
    Select Case Target.Column
        Case Is = 16
            With Sheets(Target.Value)
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = Range("A" & Target.Row)
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0) = Range("D" & Target.Row)
                .Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0) = Range("B" & Target.Row)
                .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0) = Range("E" & Target.Row)
                .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0) = Range("N" & Target.Row)
                .Cells(.Rows.Count, "G").End(xlUp).Offset(1, 0) = Range("I" & Target.Row)
            End With
        Case Is = 2
            If Range("P" & Target.Row).Value <> "" Then
                Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
                If Not ID Is Nothing Then
                    Sheets(Range("P" & Target.Row).Value).Cells(ID.Row, 3) = Target
                End If
            Else
                Exit Sub
            End If
        Case Is = 4
            If Range("P" & Target.Row).Value <> "" Then
                Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
                If Not ID Is Nothing Then
                    Sheets(Range("P" & Target.Row).Value).Cells(ID.Row, 2) = Target
                End If
            Else
                Exit Sub
            End If
        Case Is = 5
            If Range("P" & Target.Row).Value <> "" Then
                Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
                If Not ID Is Nothing Then
                    Sheets(Range("P" & Target.Row).Value).Cells(ID.Row, 4) = Target
                End If
            Else
                Exit Sub
            End If
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Display More

LanKez · Jan 28th 2020

Thanks again for helping but this doesn't seem to be working I have uploaded the spreadsheet with the new code added for you to have a look, if that's ok?

K

Mumps · Jan 28th 2020

Try:

Code

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:B,D:E,I:I,N:N,P:P")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim ID As Range
    Select Case Target.Column
        Case Is = 16
            With Sheets(Target.Value)
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = Range("A" & Target.Row)
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0) = Range("D" & Target.Row)
                .Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0) = Range("B" & Target.Row)
                .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0) = Range("E" & Target.Row)
                .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0) = Range("N" & Target.Row)
                .Cells(.Rows.Count, "G").End(xlUp).Offset(1, 0) = Range("I" & Target.Row)
            End With
        Case Is = 2
            If Range("P" & Target.Row).Value <> "" Then
                Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
                If Not ID Is Nothing Then
                    Sheets(Range("P" & Target.Row).Value).Cells(ID.Row, 3) = Target
                End If
            Else
                Application.EnableEvents = True
                Exit Sub
            End If
        Case Is = 4
        If Range("P" & Target.Row).Value <> "" Then
            Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
            If Not ID Is Nothing Then
                Sheets(Range("P" & Target.Row).Value).Cells(ID.Row, 2) = Target
            End If
        Else
            Application.EnableEvents = True
            Exit Sub
        End If
        Case Is = 5
        If Range("P" & Target.Row).Value <> "" Then
            Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
            If Not ID Is Nothing Then
                Sheets(Range("P" & Target.Row).Value).Cells(ID.Row, 4) = Target
            End If
        Else
            Application.EnableEvents = True
            Exit Sub
        End If
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Display More

LanKez · Jan 29th 2020

That's amazing thank you so much, little question though when I change priority (Column I) on the main workflow page it doesn't update on the initial tabs (Column G) but everything else does, is there anything I can add or am I pushing my luck??

Thank you again

K

Mumps · Jan 29th 2020

Try:

Code

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:B,D:E,I:I,N:N,P:P")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim ID As Range
    Select Case Target.Column
        Case Is = 16
            With Sheets(Target.Value)
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = Range("A" & Target.Row)
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0) = Range("D" & Target.Row)
                .Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0) = Range("B" & Target.Row)
                .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0) = Range("E" & Target.Row)
                .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0) = Range("N" & Target.Row)
                .Cells(.Rows.Count, "G").End(xlUp).Offset(1, 0) = Range("I" & Target.Row)
            End With
        Case Is = 2
            If Range("P" & Target.Row).Value <> "" Then
                Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
                If Not ID Is Nothing Then
                    Sheets(Range("P" & Target.Row).Value).Cells(ID.Row, 3) = Target
                End If
            Else
                Application.EnableEvents = True
                Exit Sub
            End If
        Case Is = 4
        If Range("P" & Target.Row).Value <> "" Then
            Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
            If Not ID Is Nothing Then
                Sheets(Range("P" & Target.Row).Value).Cells(ID.Row, 2) = Target
            End If
        Else
            Application.EnableEvents = True
            Exit Sub
        End If
        Case Is = 5
        If Range("P" & Target.Row).Value <> "" Then
            Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
            If Not ID Is Nothing Then
                Sheets(Range("P" & Target.Row).Value).Cells(ID.Row, 4) = Target
            End If
        Else
            Application.EnableEvents = True
            Exit Sub
        End If
        Case Is = 9
            If Range("P" & Target.Row).Value <> "" Then
                Set ID = Sheets(Range("P" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row), LookIn:=xlValues, lookat:=xlWhole)
                If Not ID Is Nothing Then
                    Sheets(Range("P" & Target.Row).Value).Cells(ID.Row, 7) = Target
                End If
            Else
                Application.EnableEvents = True
                Exit Sub
            End If
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Display More

VBA - Transfer data to tab based on intials and then delete from tabs once date completed - Help

Participate now!

Share

Users Viewing This Thread