PDA

View Full Version : [SOLVED] Updating sheet with data from another sheet



DeadKing
02-25-2014, 07:22 AM
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
02-28-2014, 05:26 PM
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
03-01-2014, 02:40 AM
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
03-01-2014, 12:55 PM
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
03-01-2014, 01:24 PM
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 :devil2:


ul

DeadKing
04-01-2014, 05:44 AM
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
04-07-2014, 06:28 AM
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 :devil2:


ul