Updating sheet with data from another sheet

[DeadKing]

Hello there,

I'm still quite new to VBA and I'm facing optimization problem with quite simple macro working with a lot of data.

To describe what I need to acheive:
I have two sheets of data. I need to take one sheet, check for data in another sheet and update it if needed. Visual usually works best so bellow you can find very simplified example.
As you might see, I have some data in sheet 1 and 2. I need to take ID from sheet 2, check for it in sheet 1 and see if it is there.
If yes, I need to update all cells on corresponding row in sheet 1 with data from 2. 2 does not have to contain all the data for the row, so I need to be sure I'm not removing anything from 1 by copying empty cells from 2 (as shown with ID 555).
If not, I need to add new ID and all it's data from 2 to 1 (as shown with ID 666, 777 and 888).
As shown with ID 111, sheet 2 does not have to contain all the IDs listed in sheet 1 and vice versa.

I have a brute-force macro simply comparing ID from 2 to IDs from 1 as strings deciding what to do in double loop, but this is terrible inefficient, since I have to work with for example 10 000 rows on sheet 1 and another 18 000 rows on sheet 2 (both have about 50 columns), which can end up as sheet 1 having 25 000 rows in total after the update (I don't care for sheet 2 when it is done).

So, any tips how to smoothen the code and reach best working speed would be much appreciated.

And here is the example I promised

sheet 1 (original data)
name	surname	ID	status	note
John	Doe	111	pending
Jane	Dee	222	ok	married
Adam		333	ok
Default	Name	444	pending
Peter	Pan	555		check
sheet 2 (updated data)
name	surname	ID	status	note
Jane	Dee	222	valid	still married
Adam	Brown	333	valid
Simon	Whatisname	444	ok	check
Peter	Pan	555	ok
Arthur	Novak	666	valid
Anna	Marie	777	ok	single
Lili	White	888	ok	check
sheet 1 (updated)
name	surname	ID	status	note
John	Doe	111	pending
Jane	Dee	222	valid
Adam	Brown	333	valid	still married
Simon	Whatisname	444	ok
Peter	Pan	555	ok	check
Arthur	Novak	666	valid	check
Anna	Marie	777	ok	single
Lili	White	888	ok	check

[mrojas]

Here's the overall picture on how I would go about this challenge, and just as you might imagine, there's more than one way of doing this, so my suggestion here might be different than others'.
Some assumptions: Name, Surname, ID, Status and Note are in columns A to E, and data starts on row 2


Determine how many rows are in sheet 1
In a loop, starting with row 2 in sheet 2, and continuing to the last row, traverse cells in sheet 1 column labeled ID(C).

If found, check cell in column D, and if is empty, replace with value in variable strStatus, else, do nothing.

Repeat process for column E.

If the cell in column C (the ID) is not found, insert a new row and replace cell values with those in sheet 2

The code below, although incomplete, it'll get you started, it might look something like this:

    Dim lngRows As Long
    Dim lngID As Long
    Dim strStatus As String
    Dim strNote As String
    
    lngRows = Sheets(2).Range("A1").CurrentRegion.Rows.Count
    lngRowCounter = 2
    'Name(A), SurName(B), ID(C), Status(D), Note(E)
    For i = 2 To lngRows
        Sheets(2).Select
        ' Store values in variables
        lngID = Range("C" & i)
        strStatus = Range("D" & i)
        strNote = Range("E" & i)
        
        ' Here's where you start traversing all rows in sheet 1
        Sheets(1).Select ' Switch to sheet 1
        For Each rw In Worksheets(intSheet).Rows
            If Range("E" & rw) = lngID Then ' Do IDs match?
                Range("D" & rw).Select '
                If Not IsEmpty("D" & rw) = True Then 'Check if status is blank
                    If Range("D" & rw) = lngID Then
                        If Not IsEmpty("D" & rw) = True Then
                            Range("D" & rw) = strStatus
                        End If
                        If Not IsEmpty("E" & rw) = True Then
                            Range("E" & rw) = strNote
                        End If
                    End If
                End If
            Else
                ' Add a row and insert values from sheet 2
            End If
        Next rw
    Next i

To get all to work, create a button and on its click event place the code shown here.

[georgiboy]

Hi There.

Here is a slightly different approach as there will be many ways to achieve this.

I am also assuming that your data runs from columns A to E and starts at row 2.

This code uses the find function and should avoid a second loop. It will also cut new entries from sheet2 and paste them at the bottom of sheet1.

I am not sure but there seems to be a few errors in your example data, this made it a bit tricky to check what you need.

Going on your text this code should do the trick.

Sub UpdateData()    
    Dim rCell As Range, fRange As String
    
    On Error Resume Next
    For Each rCell In Sheet2.Range("C2:C" & Sheet2.Range("C" & Rows.Count).End(xlUp).Row).Cells
    
        'Adds missing entries
        If WorksheetFunction.CountIf(Sheet1.Range("C:C"), rCell.Value) < 1 Then
            'Cut the data from sheet 2
            Sheet2.Range(rCell.Offset(, -2), rCell.Offset(, 2)).Cut _
                Sheet1.Range("A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1)
        End If
        
        'Update data to existing entries
        fRange = Sheet1.Range("C:C").Find(What:=rCell.Value, After:=Sheet1.Range("C1"), LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
            , SearchFormat:=False).Address
        
        If rCell.Offset(, -2).Value <> "" Then Sheet1.Range(fRange).Offset(, -2).Value = rCell.Offset(, -2).Value 'Forename
        If rCell.Offset(, -1).Value <> "" Then Sheet1.Range(fRange).Offset(, -1).Value = rCell.Offset(, -1).Value 'Surname
        If rCell.Offset(, 1).Value <> "" Then Sheet1.Range(fRange).Offset(, 1).Value = rCell.Offset(, 1).Value 'Status
        If rCell.Offset(, 2).Value <> "" Then Sheet1.Range(fRange).Offset(, 2).Value = rCell.Offset(, 2).Value 'Note
    Next rCell


End Sub

Hope this helps

George

[Paul_Hossler]

Q1: 222 - Sheet1=Married, Sheet2=Still Married, Sheet1updated = blank -- I assume that's typo

Q2: Is ID unique -- assume it is

Q3: Is this the logic you're using, using Old, New, and Updated as sheet names, and assuming that you want all the fields in the row

1. If ID in Old, but not in New then
add ID Old row to Updated

2. If ID in New, but not in Old then
add ID New row to Updated

3. If ID in Old and ID in New then
add ID Old row to Updated
all non-empty cells from ID New replace corresponding cells in Updated

4. Delete Old and rename Updated as Old (I wouldn't recommend this)


Paul

[Paul_Hossler]

Something like this

Option Explicit

Const iID As Long = 3       '   ID column number

Sub UpdateAndMerge()
    
    Dim wsOld As Worksheet, wsUpdates As Worksheet, wsRevised As Worksheet
    Dim rOld As Range, rUpdates As Range, rRevised As Range, rRow As Range, rCell As Range
    
    Dim iMatched As Long
    Application.ScreenUpdating = False
    
    Set wsOld = Worksheets("Sheet1")
    Set wsUpdates = Worksheets("Sheet2")
    
    Set rOld = wsOld.Cells(1, 1).CurrentRegion
    Set rUpdates = wsUpdates.Cells(1, 1).CurrentRegion
    
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Revised").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    wsOld.Copy After:=wsUpdates
    Set wsRevised = ActiveSheet
    wsRevised.Name = "Revised"
    
    'take each update sheet row
    For Each rRow In rUpdates.Rows
        If rRow.Row > 1 Then        '   skip header row
            
            'see if the ID number is on the copy of the original data
            iMatched = 0
            On Error Resume Next
            iMatched = Application.WorksheetFunction.Match(rRow.Cells(1, iID).Value, wsRevised.Columns(iID), 0)
            On Error GoTo 0
            
            'if that ID number is not there
            If iMatched = 0 Then        '   record added, so copy to bottom blank row
                Call rRow.Copy(wsRevised.Cells(1, 1).End(xlDown).Offset(1, 0))
            'otherwise if the ID number IS there, then look for non-blank cells in the Updated
            Else                        '   Old row number for updated record
                For Each rCell In rRow.Cells
                    If Len(rCell.Value) > 0 Then wsRevised.Cells(iMatched, rCell.Column).Value = rCell.Value
                Next
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

There's plenty of ways to speed this up, but the code gets a little (not much) complex

Also less tedious if you have 50 columns

If you want to continue with your macro since you're more familiar with it, post it and I'm sure everyone will be glad to take pot shots at it


ul

[DeadKing]

Hello,

thank you all for tips. I'll get back to it and try to find some effective way to slove it... Since the task changed few times through last weeks there is no reason to continue in this thread, so please cosider it solved.

And yes, ID 222 was my typo.

[devintyson]

Something like this

Option Explicit

Const iID As Long = 3       '   ID column number

Sub UpdateAndMerge()
    
    Dim wsOld As Worksheet, wsUpdates As Worksheet, wsRevised As Worksheet
    Dim rOld As Range, rUpdates As Range, rRevised As Range, rRow As Range, rCell As Range
    
    Dim iMatched As Long
    Application.ScreenUpdating = False
    
    Set wsOld = Worksheets("Sheet1")
    Set wsUpdates = Worksheets("Sheet2")
    
    Set rOld = wsOld.Cells(1, 1).CurrentRegion
    Set rUpdates = wsUpdates.Cells(1, 1).CurrentRegion
    
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Revised").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    wsOld.Copy After:=wsUpdates
    Set wsRevised = ActiveSheet
    wsRevised.Name = "Revised"
    
    'take each update sheet row
    For Each rRow In rUpdates.Rows
        If rRow.Row > 1 Then        '   skip header row
            
            'see if the ID number is on the copy of the original data
            iMatched = 0
            On Error Resume Next
            iMatched = Application.WorksheetFunction.Match(rRow.Cells(1, iID).Value, wsRevised.Columns(iID), 0)
            On Error GoTo 0
            
            'if that ID number is not there
            If iMatched = 0 Then        '   record added, so copy to bottom blank row
                Call rRow.Copy(wsRevised.Cells(1, 1).End(xlDown).Offset(1, 0))
            'otherwise if the ID number IS there, then look for non-blank cells in the Updated
            Else                        '   Old row number for updated record
                For Each rCell In rRow.Cells
                    If Len(rCell.Value) > 0 Then wsRevised.Cells(iMatched, rCell.Column).Value = rCell.Value
                Next
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

There's plenty of ways to speed this up, but the code gets a little (not much) complex

Also less tedious if you have 50 columns

If you want to continue with your macro since you're more familiar with it, post it and I'm sure everyone will be glad to take pot shots at it


ul