Compare and update please help
 

One trick in this exercise is that it is not necessary to check an
values - just replace the data. This saves a couple of lines of code
and therefore saves process time over large numbers of records.

I have also found that Copy/Paste is faster than writing values t
cells. This code adds the "new" record to the bottom of the data if i
cannot find a match.

'---------------------------------------------------------
Sub transfer_data()
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim FoundCell As Object
Dim FromRow As Long
Dim ToRow As Long
Dim LastRow As Long
Dim FindValue
Dim PasteRange As Range
'--------------------------
Application.Calculation = xlCalculationManual
Set FromSheet = ActiveSheet
Set ToSheet = Workbooks("Book1.xls").Worksheets("data")
LastRow = ToSheet.Range("A65536").End(xlUp).Row + 1
FromRow = 2
While FromSheet.Cells(FromRow, 1).Value < ""
' find record
FindValue = FromSheet.Cells(FromRow, 1).Value
FromSheet.Range("A" & FromRow & ":H" & FromRow).Copy
Set FoundCell = ToSheet.Columns(1).Find(what:=FindValue)
If FoundCell Is Nothing Then
' add data to bottom of list
Set PasteRange = ToSheet.Range("A" & LastRow)
LastRow = LastRow + 1
Else
' replace data
ToRow = FoundCell.Row
Set PasteRange = ToSheet.Range("A" & ToRow)
End If
ToSheet.Paste Destination:=PasteRange
FromRow = FromRow + 1
Wend
Application.Calculation = xlCalculationAutomatic
MsgBox ("Done")
End Sub
'---------------------------------------------------------------

--
Message posted from http://www.ExcelForum.com

Compare and update please help
 

Thanks Brian that's great!
Every now and then the updates Ireceive have the columns changed
around on me and I have to change them back them back to look like the
Master but the column heading neve change.
Would it be possbile to set it up so that the macro can look for
column heading s and paste the updates appropriately?















BrianB wrote in message ...
One trick in this exercise is that it is not necessary to check any
values - just replace the data. This saves a couple of lines of code -
and therefore saves process time over large numbers of records.

I have also found that Copy/Paste is faster than writing values to
cells. This code adds the "new" record to the bottom of the data if it
cannot find a match.

'---------------------------------------------------------
Sub transfer_data()
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim FoundCell As Object
Dim FromRow As Long
Dim ToRow As Long
Dim LastRow As Long
Dim FindValue
Dim PasteRange As Range
'--------------------------
Application.Calculation = xlCalculationManual
Set FromSheet = ActiveSheet
Set ToSheet = Workbooks("Book1.xls").Worksheets("data")
LastRow = ToSheet.Range("A65536").End(xlUp).Row + 1
FromRow = 2
While FromSheet.Cells(FromRow, 1).Value < ""
' find record
FindValue = FromSheet.Cells(FromRow, 1).Value
FromSheet.Range("A" & FromRow & ":H" & FromRow).Copy
Set FoundCell = ToSheet.Columns(1).Find(what:=FindValue)
If FoundCell Is Nothing Then
' add data to bottom of list
Set PasteRange = ToSheet.Range("A" & LastRow)
LastRow = LastRow + 1
Else
' replace data
ToRow = FoundCell.Row
Set PasteRange = ToSheet.Range("A" & ToRow)
End If
ToSheet.Paste Destination:=PasteRange
FromRow = FromRow + 1
Wend
Application.Calculation = xlCalculationAutomatic
MsgBox ("Done")
End Sub
'----------------------------------------------------------------


---
Message posted from http://www.ExcelForum.com/