Consulting

Results 1 to 7 of 7

Thread: Updating sheet with data from another sheet

  1. #1
    VBAX Regular
    Joined
    Oct 2011
    Posts
    13
    Location

    Updating sheet with data from another sheet

    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

  2. #2
    VBAX Contributor
    Joined
    Oct 2011
    Location
    Concord, California
    Posts
    101
    Location
    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.

  3. #3
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    569
    Location
    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
    I was not told it was impossible, so i did it.

  4. #4
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,497
    Location
    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

  5. #5
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,497
    Location
    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
    Attached Files Attached Files

  6. #6
    VBAX Regular
    Joined
    Oct 2011
    Posts
    13
    Location
    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.

  7. #7

    Talking Thanks

    Quote Originally Posted by Paul_Hossler View Post
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •