How to update specific columns and rows based on primary keys from import
Category: [Excel] Demo Available
How to update specific columns and rows based on primary keys from import
Requirement:
The user creating a document for a company to keep track of maintenance orders. The status and details of these orders change throughout the day, and well as new orders being created throughout the day.
The company currently keeps track of these requests by exporting data from our scheduling software, and copy and pasting it into a new excel document several times throughout the day.
The user has been asked to find a way keep a single master database up-to-date.
The user needs to paste an export from the scheduling software into sheet 2, and then run a script to do the following:
- Using the primary key (CASTEVENTID) in column A, search "sheet 1" to find duplicates with sheet 2.
- When a duplicate is found, overwrite the data in sheet 1 columns: H, I, J, K, M, N, with the same columns in sheet 2
- Preferably keeping the formatting already applied in sheet 1.
- For new primary keys in sheet 2 that are not found in sheet 1 as duplicates, those entire rows need to be copied to the bottom of the table in sheet 1 as new records.
A sample file is attached.
Solution:
Code:
Sub CopyRange()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("Sheet 2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim LastRow2 As Long
LastRow2 = Sheets("Sheet 1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Dim ID As Range, foundID As Range
For Each ID In Sheets("Sheet 2").Range("A2:A" & LastRow)
Set foundID = Sheets("Sheet 1").Range("A:A").Find(ID, LookIn:=xlValues, lookat:=xlWhole)
If Not foundID Is Nothing Then
Sheets("Sheet 2").Range("H" & ID.Row & ":K" & ID.Row).Copy
Sheets("Sheet 1").Range("H" & foundID.Row).PasteSpecial xlPasteValues
Sheets("Sheet 2").Range("M" & ID.Row & ":N" & ID.Row).Copy
Sheets("Sheet 1").Range("M" & foundID.Row).PasteSpecial xlPasteValues
Else
LastRow2 = Sheets("Sheet 1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ID.EntireRow.Copy
Sheets("Sheet 1").Cells(LastRow2, 1).PasteSpecial xlPasteValues
End If
Next ID
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Obtained from the OzGrid Help Forum.
Solution provided by Mumps.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to use Excel VBA macro to import data from multiple workbooks to main workbook |
| How to import data in a specific sheet from another workbook (sheet number must be variable) |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.