Transfer data from worksheet to another based on criteria RRS feed

  • Question

  • I have a basic workbook  in which I store data about my workforce.

    I have a "Master" worksheet where I record persons "name", "date" and "task", there could be multiple rows containing data about each person. I also have a Tab for each member of my workforce where I then transfer the data relevant to them from the master sheet.

    I currently copy and paste this data. I would like this to happen automatically whenever "Master" is updated.



    Thursday, March 30, 2017 5:00 PM

All replies

  • Hi Steve,

    You could write code in Master worksheet's worksheet_change event so every time you update the data the code will run.

    For updating data, you need a primary key so that you could catch the same data in member's worksheet, for instance, a ID fields.

    In my case, I set task as primary key.

    Here is the example.

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws, ws2 As Worksheet
    Dim usedRng, usedRng2 As Range
    Dim name, datestr, task As String
    Set ws = ActiveSheet
    Set usedRng = ws.UsedRange
    Application.ScreenUpdating = False
    name = Cells(Target.Row, 1)
    datestr = Cells(Target.Row, 2)
    task = Cells(Target.Row, 3)
    'if there is a new name,create a new sheet
    If Not ExistSheet(name) Then
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Cells(1, 1) = "Name"
    ActiveSheet.Cells(1, 2) = "Date"
    ActiveSheet.Cells(1, 3) = "Task" = name
    End If
    Set ws2 = Sheets(name)
    Set usedRng2 = ws2.UsedRange
    Dim flag As Boolean
    flag = False
    'update data depend on task
    For i = 2 To usedRng2.Rows.Count
    If ws2.Cells(i, 3) = task Then
    ws2.Cells(i, 1) = name
    ws2.Cells(i, 2) = datestr
    flag = True
    Exit For
    End If
    Next i
    'insert a new task
    If Not flag Then
    ws2.Cells(usedRng2.Rows.Count + 1, 1) = name
    ws2.Cells(usedRng2.Rows.Count + 1, 2) = datestr
    ws2.Cells(usedRng2.Rows.Count + 1, 3) = task
    End If
    Application.ScreenUpdating = True
    End Sub
    'check if there is member's sheet
    Function ExistSheet(ByVal sheetName As String)
    ExistSheet = False
    For i = 1 To Sheets.Count
    If Sheets(i).name = sheetName Then
    ExistSheet = True
    Exit For
    End If
    Next i
    End Function

    Best Regards,


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact

    Friday, March 31, 2017 8:35 AM