Updating target Worksheet from changing source Worksheet

A

adambc

Active Member
Joined
Jan 13, 2020
Messages
412
Office Version
  1. 365
Platform
  1. Windows
I get extracts from a source system daily (source WS) …

The source WS has 8 columns including a Record ID in column A …

I have a target WS with the same 8 columns, with 3 additional columns that are used to manually annotate comments to records …

When I get a new source WS, I want to check (using the Record ID) whether the record exists in the target WS …

- if it does, I want to update the first 8 columns in the target WS with the data from the same 8 columns in the source WS …
- if it doesn’t exist, I want to add a new record to the target WS, populating the first 8 columns with the data from the same columns in the source WS (leaving the additional columns in the target WS blank)

I then want to check whether all records in the target WS exist in the new source WS and if they don’t, delete the record in the target WS …

But I’m going round in circles! - can anyone give me a helping hand please?

Many thanks …
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
See if this is what you want. This is all in the same workbook. The Source sheet is named "source" and the Target Sheet is named "target". Please test on a backup copy of your data. This code will delete data that is not easily recoverable.

Source Sheet:
circles.xlsm
ABCDEFGH
1Record IDCol 2Col 3Col 4Col 5Col 6Col 7Col 8
2AA 22A 23A 24A 25A 26A 27A 28
3BB 22B 23B 24B 25B 26B 27B 28
4CC 22C 23C 24C 25C 26C 27C 28
source


Target Sheet:
circles.xlsm
ABCDEFGHIJK
1Record IDCol 2Col 3Col 4Col 5Col 6Col 7Col 8Col 9Col 10Col 11
2BB 2B 3B 4B 5B 6B 7B 8B 9B 10B 11
3CC 2C 3C 4C 5C 6C 7C 8C 9C 10C 11
4DD 2D 3D 4D 5D 6D 7D 8D 9D 10D 11
target


Resulting Target Sheet:
circles.xlsm
ABCDEFGHIJK
1Record IDCol 2Col 3Col 4Col 5Col 6Col 7Col 8Col 9Col 10Col 11
2BB 22B 23B 24B 25B 26B 27B 28B 9B 10B 11
3CC 22C 23C 24C 25C 26C 27C 28C 9C 10C 11
4AA 22A 23A 24A 25A 26A 27A 28
target


VBA Code: 
Sub Circles()

    Dim wsS As Worksheet: Set wsS = Worksheets("source")
    Dim wsT As Worksheet: Set wsT = Worksheets("target")
    Dim sArr, tArr, finArr, i As Long, r As Long, t As Long
    Dim SlRow As Long, TlRow As Long, lRow As Long, ct As Long
    Dim writ As Boolean
    
    Application.ScreenUpdating = False
    SlRow = wsS.Cells(Rows.Count, 1).End(xlUp).Row
    TlRow = wsT.Cells(Rows.Count, 1).End(xlUp).Row
    lRow = SlRow + TlRow
    sArr = wsS.Range("A2:H" & SlRow)
    tArr = wsT.Range("A2:L" & lRow)
    
    For i = 1 To UBound(sArr)
        For r = 1 To UBound(tArr)
            If sArr(i, 1) = tArr(r, 1) Then
                For t = 2 To 8
                    tArr(r, t) = sArr(i, t)
                    tArr(r, 12) = "True"
                    writ = True
                Next
            End If
        Next
        If writ = False Then
            tArr(UBound(sArr) + i, 1) = sArr(i, 1)
            tArr(UBound(sArr) + 1, 12) = "True"
            For t = 2 To 8
                tArr(UBound(sArr) + 1, t) = sArr(i, t)
            Next
        End If
    Next
    ct = 1
    ReDim finArr(1 To UBound(tArr, 1), 1 To UBound(tArr, 2))
    For i = 1 To UBound(tArr)
        If Not tArr(i, 12) = Empty Then
            For r = 1 To 12
                finArr(ct, r) = tArr(i, r)
            Next
            ct = ct + 1
        End If
    Next
    wsT.Range("A2:L" & TlRow).Clear
    wsT.Range("A2").Resize(UBound(finArr, 1), UBound(finArr, 2) - 1) = finArr
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
@igold

Many thanks for this ...

I think I understand what's happening, but can I just check?

First, "writ" is a variable you are setting to isolate new records?

More importantly, you are creating the "Resulting Target Sheet" in memory, clearing the Original Target Sheet with wsT.Range("A2:L" & TlRow).Clear - and replacing it with the Resulting Target Sheet?

Assuming I'm correct, I now need to make a few tweaks, but am pretty confident I can get it to do exactly what I need?

Thanks again ...
 
Upvote 0
You're welcome, I was happy to help. Thanks for the feedback.

Yes "writ" is catching the new records, and yes I am wiping the Target sheet and rewriting it every time the code is run...

I hope I gave you something you can use as a jump off point with your own code. Try to do everything in memory and do not go to and from the worksheet in the middle of your loop.
 
Upvote 0
igold said:
You're welcome, I was happy to help. Thanks for the feedback.

Yes "writ" is catching the new records, and yes I am wiping the Target sheet and rewriting it every time the code is run...

I hope I gave you something you can use as a jump off point with your own code. Try to do everything in memory and do not go to and from the worksheet in the middle of your loop.
Click to expand...
@igold

Bit of a problem!

The code is "updating" the records that exist in my source and target - and "removing" the records in my target that are not in my source - but the records that are in my source that are not in my target are not being "added" to my source!

So I tested using your source/target/code with an additional record (E) in the source - and record E does not appear in the target after running your code!

Is it something to do with the piece bolded below because the two arrays are the same size?

VBA Code: 
If writ = False Then
            tArr([B]UBound(sArr)[/B] + i, 1) = sArr(i, 1)
            tArr([B]UBound(sArr)[/B] + 1, 12) = "True"
            For t = 2 To 8
                tArr([B]UBound(sArr)[/B] + 1, t) = sArr(i, t)
            Next
        End If

There is also another issue with the "updating" in so much as the manual columns in the target that I want to preserve also have text colours and fills which are not preserved, but I think that can be handled by playing around with the arrays?

Thanks ...
 
Upvote 0
adambc said:
but the records that are in my source that are not in my target are not being "added" to my source!
Click to expand...
A little confused with this statement. If the records are in your source why would they then have to "added" to the source.
Perhaps you could post some data (real or fictitious) showing what you are starting with and what you would like results to be (XL2BB would be nice). Similar to what I did in Post #2. You should also supply the VBA that you are using...

Using arrays is never going to preserve your formatting. You will either have to have code that formats your results or use a coding strategy that copies and pastes instead.

Edit: I just added a Record "E" and you are right my code did not work. I will try to supply a working code for you.
 
Upvote 0
Try this updated code....
VBA Code: 
Sub Circles()

    Dim wsS As Worksheet: Set wsS = Worksheets("source")
    Dim wsT As Worksheet: Set wsT = Worksheets("target")
    Dim sArr, tArr, finArr, i As Long, r As Long, t As Long
    Dim SlRow As Long, TlRow As Long, lRow As Long, ct As Long
    Dim writ As Boolean
    
    Application.ScreenUpdating = False
    SlRow = wsS.Cells(Rows.Count, 1).End(xlUp).Row
    TlRow = wsT.Cells(Rows.Count, 1).End(xlUp).Row
    lRow = SlRow + TlRow
    sArr = wsS.Range("A2:H" & SlRow)
    tArr = wsT.Range("A2:L" & lRow)
    
    For i = 1 To UBound(sArr)
        writ = False
        For r = 1 To UBound(tArr)
            If sArr(i, 1) = tArr(r, 1) Then
                For t = 2 To 8
                    tArr(r, t) = sArr(i, t)
                    tArr(r, 12) = "True"
                    writ = True
                Next
            End If
        Next
        If writ = False Then
            tArr(UBound(sArr) + i, 1) = sArr(i, 1)
            tArr(UBound(sArr) + i, 12) = "True"
            For t = 2 To 8
                tArr(UBound(sArr) + i, t) = sArr(i, t)
            Next
        End If
    Next
    ct = 1
    ReDim finArr(1 To UBound(tArr, 1), 1 To UBound(tArr, 2))
    For i = 1 To UBound(tArr)
        If Not tArr(i, 12) = Empty Then
            For r = 1 To 12
                finArr(ct, r) = tArr(i, r)
            Next
            ct = ct + 1
        End If
    Next
    wsT.Range("A2:L" & TlRow).Clear
    wsT.Range("A2").Resize(UBound(finArr, 1), UBound(finArr, 2) - 1) = finArr
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
igold said:
Try this updated code....
VBA Code: 
Sub Circles()

    Dim wsS As Worksheet: Set wsS = Worksheets("source")
    Dim wsT As Worksheet: Set wsT = Worksheets("target")
    Dim sArr, tArr, finArr, i As Long, r As Long, t As Long
    Dim SlRow As Long, TlRow As Long, lRow As Long, ct As Long
    Dim writ As Boolean
   
    Application.ScreenUpdating = False
    SlRow = wsS.Cells(Rows.Count, 1).End(xlUp).Row
    TlRow = wsT.Cells(Rows.Count, 1).End(xlUp).Row
    lRow = SlRow + TlRow
    sArr = wsS.Range("A2:H" & SlRow)
    tArr = wsT.Range("A2:L" & lRow)
   
    For i = 1 To UBound(sArr)
        writ = False
        For r = 1 To UBound(tArr)
            If sArr(i, 1) = tArr(r, 1) Then
                For t = 2 To 8
                    tArr(r, t) = sArr(i, t)
                    tArr(r, 12) = "True"
                    writ = True
                Next
            End If
        Next
        If writ = False Then
            tArr(UBound(sArr) + i, 1) = sArr(i, 1)
            tArr(UBound(sArr) + i, 12) = "True"
            For t = 2 To 8
                tArr(UBound(sArr) + i, t) = sArr(i, t)
            Next
        End If
    Next
    ct = 1
    ReDim finArr(1 To UBound(tArr, 1), 1 To UBound(tArr, 2))
    For i = 1 To UBound(tArr)
        If Not tArr(i, 12) = Empty Then
            For r = 1 To 12
                finArr(ct, r) = tArr(i, r)
            Next
            ct = ct + 1
        End If
    Next
    wsT.Range("A2:L" & TlRow).Clear
    wsT.Range("A2").Resize(UBound(finArr, 1), UBound(finArr, 2) - 1) = finArr
    Application.ScreenUpdating = True
   
End Sub
Click to expand...
Testing with your data first ...

With Record E OK, but if I add Record F to the source I get a Subscript out of range on tArr(UBound(sArr) + i, 1) = sArr(i, 1)

Interestingly with my data (adding writ = False, which I think is the only change?, to my adapted code) I don't get an error, but I only get 1 new record in the target which is the last of the 5 new records in the source (and even then
tArr(UBound(sArr) + i, 1)
Click to expand...
which should be the ID is blank) as if the code is overwriting rather than creating a new record on a new row
 
Upvote 0
Other than adding the writ = false, I stupidly had some "1"s in the arrays where I meant for there to be an "i", that too was changed. Let me look again and add more than one or two lines of my own fictitious data.

A sampling of your data would go a long way!
 
Upvote 0
igold said:
Other than adding the writ = false, I stupidly had some "1"s in the arrays where I meant for there to be an "i", that too was changed. Let me look again and add more than one or two lines of my own fictitious data.

A sampling of your data would go a long way!
Click to expand...
I missed the i's for 1's - that now works on my data (not sure why it doesn't on yours?) ...

I have all 5 new records appended with their ID and the other data where I want it to be ...

I now need to think about how I can retain the aforementioned cell formatting (if at all) ...

As an aside, I'm doing this a volunteer for a charitable organisation - unfortunately I cannot share the data I'm working with (and creating some dummy data that mimics the real data is VERY difficult!) ...

Thank you again ...
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Excel 2016 VBA - Pull data from multiple sheets to One with specificities
Replies
3
Views
251
mumps
mumps
E
  • Question Question
VBA - Create a new sheet + hyperlink name
Replies
3
Views
381
excelnewbie990
E
S
  • Question Question
Worksheet Change Event
Replies
2
Views
676
sspatriots
S
duteberta
  • Question Question
VBA adding values to new table rows
Replies
8
Views
2K
Domenic
D
B
  • Question Question
VBA exports worksheet from XLSM to XLXS matching all source properties doesn't keep print area
Replies
0
Views
81
brentcole
B

Forum statistics

Threads
1,223,248
Messages
6,171,021
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top