Update a Master Sheet with Changed or New Data From Another Sheet

[idelta]

If anyone has the time, I would greatly appreciate the help with this macro.

I am trying to find a VBA method of updating a "master" sheet with new, or changed data based on another sheet.

Background (I can't upload the workbook due to proprietary information):
I have a "master" task list that I keep track of past, current, and future tasks. Each week I receive a MS Project output from our scheduling/tasking department. This output only contains current and future tasks, not old tasks. Tasks can be updated (like completion dates), or new tasks can be added. New tasks can be mixed within the output, not always at the bottom of the output.

The "master" list contains past tasks as I need to keep historical data for charging purposes. So, row data will not align between the two sheets. Additionally, the "master" list has added columns as my leads provide information as who is responsible for the task, etc.. I need to keep this data.

Between the two sheets, columns A-U are the same. In the "master", columns V-AC are the added columns. Column A in both sheets contain the unique identifier code.

The "master" sheet is titled "TMS Tasks", and the output sheet is titled "Updated TMS"


I found a VBA example of what I am trying to accomplish from a 2008 post by user Smitty
http://www.mrexcel.com/forum/excel-questions/316995-refresh-master-sheet-reflect-changes-other-sheets.html
and modified it to the limit of my VBA experience, but need more experienced help to modify it further for what I would like to do.

The code I found and have modifed to this point:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rng As Range, LstRw As Range, TMSrng As Range, c As Range
Dim TMS As String, FirstAddress As String, CurrentSheet As String
Dim ws As Worksheet

Set rng = Target.Parent.Range("A:A")
If Target.Count > 1 The Exit Sub
If Intersect(Target, rng) Is Nothing Then Exit Sub
If Target.Parent.Name <> "TMS Tasks" Then

CurrentSheet = ActiveSheet.Name
TMS = Cells(Target.Row, "A").Text
Sheets("TMS Tasks").Activate
With Sheets("TMS Tasks").Range("A1:A65500")
Set c = .Find(TMS, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Target.EntireRow.Copy Sheets("TMS Tasks").Range("A" & c.Row)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
Else
Set LstRw = Sheets("TMS Tasks").Cells(Rows.Count, "A").End(xlUp)
Target.EntireRow.Copy LstRw.Offset(1)
End If
End With
End If
End Sub

I am looking for some guidance on the following:

>I would like to move this code from a Workbook change event into a module as I don't need it to automatically update whenever I, or someone else is working in the file.

>The code works up to

Target.EntireRow.Copy LstRw.Offset(1)

then I get an error stating "Copy Method of Range Class Failed". I haven't been able to find a solution to this... mainly as I don't completely understand the Target expression.

>How do I specify to only copy over columns A-U instead of the entire row so I do not erase user input data in the proceeding columns?


I would greatly appreciate any time someone has to offer to help out. Please let me know if any additional informaton is needed.

 

[L. Howard]

Okay, I just about got it worked out.

You've been on this task for some time it looks like. I ran across some archived code referring to the FIND method on sheet TMS Tasks.
You will be seeing a similar code as that one.

Howard

 

[L. Howard]

Try this in a standard module

Howard

Option Explicit

Sub CopyStuff_1()
Dim sh1 As Worksheet, sh2 As Worksheet, OutRng As Range, aFnd As Range, c As Range
Dim lrow As Long

Set sh1 = Sheets("Output")
Set sh2 = Sheets("TMS Tasks")

Application.ScreenUpdating = True

Set OutRng = sh1.Range("A2", Range("A2").End(xlDown))

For Each c In OutRng
  With sh2

    lrow = Cells(Rows.Count, "A").End(xlUp).Row
   Set aFnd = sh2.Range("A1:A" & lrow).Find(What:=c, _
                                               LookIn:=xlValues, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                                                 
  If Not aFnd Is Nothing Then
      c.Offset(0, 0).Resize(1, 21).Copy aFnd
      
    Else
      c.Offset(0, 0).Resize(1, 21).Copy
      sh2.Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
      
  End If

 End With
 
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[idelta]

Thank you Howard for the time and energy to help with this!

I tested this out and the code is duplicating some of the "new" data each time it is ran. For example, Task 8 & 9 (the new tasks) in the Output worksheet, it wonderfully adds it the first. But if ran again, it adds those tasks again to the TMS Tasks worksheet.

With that, and oddly enough, if I remove Task 4 from TMS Tasks, run the macro it will add Task 4, 8 and 9 to the worksheet. However, if I run the macro again (back-to-back), it doesn't re-add Task 4, only Task 8 and 9.

As another test, I ran the macro, it added Task 4, 8, 9. Closed/opened the workbook, re-ran the macro and it again repeated Task 8 and 9.

I had this same issue with some of my first trial and error attempts, but could never figure out the cause. Thoughts?

As a side note - I actually understand a bit of what you wrote in the code. This is huge for me as it helps my confidence in that I am gaining some understanding of VBA through my attempts.

Again much appreciative of your help.

 

[L. Howard]

Give this a try, seems to work quite well with all I can throw at it.

Copy to a standard module.

Howard

Option Explicit

Sub UpdateTasks2()
Dim LRow As Long, i As Long
Dim varData As Variant
Dim c As Range

With Sheets("Output")
    LRow = .Cells(Rows.Count, 1).End(xlUp).Row
    varData = .Range("A2:U" & LRow)
End With
    
With Sheets("TMS Tasks")
    For i = LBound(varData) To UBound(varData)
        Set c = .Range("A:A").Find(varData(i, 1), LookIn:=xlValues)
        If c Is Nothing Then
            .Cells(Rows.Count, 1).End(xlUp)(2).Resize(1, UBound(varData, 2)) _
                = Application.Index(varData, i)
        Else
            .Cells(c.Row, 1).Resize(1, UBound(varData, 2)) _
                = Application.Index(varData, i)
        End If
    Next
End With
End Sub

 

[idelta]

This is perfect Howard! No issues with testing this out. Wow, I am greatly appreciative of your time to help me. Hopefully it wasn't too much trouble. I wish I could buy you a cup of coffee or a beer in gratitude.

And sorry for the delay in response - was out of the office over the weekend.

One last question - did you figure out was causing the duplication of the new records each time your first macro was ran, or is it just a quirk? I don't see where in your first macro that would cause this. I mean, it's pretty straight forward and clean. I ask as I had the same happen with some of my earlier attempts.

All the best to you sir!

 

[L. Howard]

You're welcome.

No, I trashed that code and sought some advice on modifying an archive code I had. I struggle working with the array codes but when done correctly they are really great and very fast.

Glad it is working for you.

Howard

 

[JonnieJarko]

Hi Howard,

I am actually wanting to use your same code to do solve the exact same problem but my vba skills are severely lacking. I was just wondering how you could get your code to paste the values into cell A14 instead of A2?
I have tried to do this with your code by switching some of the values but came up with zilch. Any help would be much appreciated.

Jonny

 

[agog09]

4 years on, and I wanted to add to the thread for anyone with a similar need. I had a task that was very close to that of the original poster. The array-based solution put forward by L. Howard ended up being the answer, with the addition of an LookAt:=xlWhole argument to the Find function.

Before that, I was getting partial matches on the ID numbers (key values) that I was matching against in my master sheet.

With Sheets("MasterSheet")
    For i = LBound(varData) To UBound(varData)                             
        Set cell = .Range("A:A").Find(varData(i, 1), LookIn:=xlValues, [COLOR=rgb(41, 105, 176)]LookAt:=xlWhole[/COLOR])     
        If cell Is Nothing Then                        
            .Cells(Rows.Count, 1).End(xlUp)(2).Resize(1, UBound(varData, 2)) _
                = Application.Index(varData, i)
                
        Else                                                     
            .Cells(cell.Row, 1).Resize(1, UBound(varData, 2)) _
                = Application.Index(varData, i)
            
            .Cells(cell.Row, 1).Interior.ColorIndex = 37
                   
        End If
    Next

End With

One other issue I encountered was with dates losing their formatting when coming out of the array. The script was correctly writing dates from the update sheet to the master sheet, but without the formatting, which broke a pivot table report I had built off the master sheet. My crude fix was to apply a TextToColumns method to the Range in the master sheet (M:M) that were supposed to be dates (DDMMYYYY):

'force Excel to interpret date values as dates (DDMMYYYY)
With Sheets("MasterSheet")
   
   .Range("M:M").TextToColumns Destination:=Range("M:M"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, _
        FieldInfo:=Array(1, 4), TrailingMinusNumbers:=True
               
End With

Anyway, I wanted to add something back to the thread out of gratitude to idelta and L. Howard. Without you both, I don't know how I would have gotten my problem sorted, and I learned a lot in the process.