Macro for checking if a value exists in a different workbook and adding it if it is missing

Sushajith · Aug 19, 2013

Hi there. I would like to have a macro designed. I have 2 workbooks, one having latest information and the other having the information in database already. both workbooks have 26 columns each. I would like to check if a value that exists in Column A of the "latest-information" workbook also exists in the "already-in-database" workbook. If so, I would like to update all 26 columns of that row in the "already-in-database" workbook with information from the "latest-information" workbook. If the value does not exist, I would like to add all 26 fields in that row into a new sheet on the "already-in-database" workbook. Please help me with this query!

sijpie · Aug 20, 2013

How familiar are you with macros? have you searched for finding copying duplicate date?

Sushajith · Aug 20, 2013

I am pretty decent with macros. I have actually done comparing of 2 sets of values on macros. But I have never done comparing 2 sets of values and then extracting data using macros before.

sijpie · Aug 21, 2013

OK, this code should get you going: It is supposed to be in the workbook containing the new data. It will ask you to point out the database workbook to be refreshed (which does not have to be open).

Option Explicit '--------------------------------------------- Sub UpdateDB() ' ' Macro to update the Database book with the _ new values in the current workbook _ The macro will request the name of the _ DB workbook, and open it if not already _ open. '--------------------------------------------- Dim wbLate As Workbook, wbDB As Workbook Dim rNew As Range, rOutp As Range Dim sDBName As String, sPath As String Dim bFl As Boolean 'set screenflikker off Application.ScreenUpdating = False Set wbLate = ThisWorkbook ' Get the name of database WB With Application.FileDialog(msoFileDialogOpen) .Title = "Select Database File to be updated" .Filters.Add "Excel Files", "*.xls*" .InitialFileName = wbLate.Path .Show If .SelectedItems.Count = 0 Then GoTo CleanUp sPath = .SelectedItems(1) End With ' get the file name from path sDBName = GetFName(sPath) On Error Resume Next ' check if file already open Set wbDB = Workbooks(sDBName) On Error GoTo 0 If wbDB Is Nothing Then ' DB was not open yet bFl = True Set wbDB = Workbooks.Open(sPath) End If Set rNew = wbLate.ActiveSheet.Range("A1") ' as we are transferring lots of data speed up _ process, by not doing recalcs etc. Application.EnableEvents = False Do While rNew.Value <> vbNullString 'go through each row until empty row Set rOutp = wbDB.ActiveSheet.Columns("A").Find(rNew.Value, _ searchdirection:=xlNext) If rOutp Is Nothing Then ' not found, so add ' find bottom row Set rOutp = wbDB.ActiveSheet.Columns("A").Find(what:="*", _ after:=Cells(1, 1), _ searchdirection:=xlPrevious).Offset(1, 0) End If ' set values to row of new data rOutp.Resize(1, rNew.CurrentRegion.Columns.Count).Value = _ rNew.Resize(1, rNew.CurrentRegion.Columns.Count).Value Set rNew = rNew.Offset(1, 0) ' one row down Loop Application.EnableEvents = True 'close DB file if it was not open If bFl Then wbDB.Close savechanges:=True End If MsgBox "Successfully updated" CleanUp: Set wbLate = Nothing Set wbDB = Nothing Set rNew = Nothing Set rOutp = Nothing Application.ScreenUpdating = True End Sub '-------------------------------------------- Function GetFName(sPath As String) As String ' ' Function that splits the filename from _ the path passed as parameter. Function _ returns the file name. '-------------------------------------------- GetFName = Right(sPath, Len(sPath) - InStrRev(sPath, "\")) End Function 

If you rather have the macro in the DB workbook because the new data workbooks come from somewhere else, then let me know. Easy rewrite.

floddy · Apr 16, 2015

Hello sijpie,

I know it's an old post, but by any chance can you modify code to be run from DB file?

Thank you.

sijpie · Apr 16, 2015

I can but not for the next week as I don't have access to a PC. But you can do it yourself.

In the code above change
Set wbLate = ThisWorkbook
To
Set wbDB = ThisWorkbook

And change the two occurrences of
Set wbDB = ...
To
Set wbLate = ...

That should do the trick

floddy · Apr 17, 2015

sijpie said:
I can but not for the next week as I don't have access to a PC. But you can do it yourself.

In the code above change
Set wbLate = ThisWorkbook
To
Set wbDB = ThisWorkbook

And change the two occurrences of
Set wbDB = ...
To
Set wbLate = ...

That should do the trick

Thank's a lot.

I'll give it a try.

sijpie · Apr 21, 2015

I haven't tested it but code should be:

Option Explicit '--------------------------------------------- Sub UpdateDB() ' ' Macro to update the Database book with the _ new values in a workbook to be selected. _ The macro will request the name of the _ workbook, and open it if not already _ open. '--------------------------------------------- Dim wbLate As Workbook, wbDB As Workbook Dim rNew As Range, rOutp As Range Dim sDBName As String, sPath As String Dim bFl As Boolean 'set screenflikker off Application.ScreenUpdating = False Set wbDB = ThisWorkbook ' Get the name of data WB With Application.FileDialog(msoFileDialogOpen) .Title = "Select File to update this Databse with" .Filters.Add "Excel Files", "*.xls*" .InitialFileName = wbDB.Path .Show If .SelectedItems.Count = 0 Then GoTo CleanUp sPath = .SelectedItems(1) End With ' get the file name from path sDBName = GetFName(sPath) On Error Resume Next ' check if file already open Set wbLate = Workbooks(sDBName) On Error GoTo 0 If wbLate Is Nothing Then ' WB was not open yet bFl = True Set wbLate = Workbooks.Open(sPath) End If Set rNew = wbLate.ActiveSheet.Range("A1") ' as we are transferring lots of data speed up _ process, by not doing recalcs etc. Application.EnableEvents = False Do While rNew.Value <> vbNullString 'go through each row until empty row Set rOutp = wbDB.ActiveSheet.Columns("A").Find(rNew.Value, _ searchdirection:=xlNext) If rOutp Is Nothing Then ' not found, so add ' find bottom row Set rOutp = wbDB.ActiveSheet.Columns("A").Find(what:="*", _ after:=Cells(1, 1), _ searchdirection:=xlPrevious).Offset(1, 0) End If ' set values to row of new data rOutp.Resize(1, rNew.CurrentRegion.Columns.Count).Value = _ rNew.Resize(1, rNew.CurrentRegion.Columns.Count).Value Set rNew = rNew.Offset(1, 0) ' one row down Loop Application.EnableEvents = True 'close DB file if it was not open If bFl Then wbDB.Close savechanges:=True End If MsgBox "Successfully updated" CleanUp: Set wbLate = Nothing Set wbDB = Nothing Set rNew = Nothing Set rOutp = Nothing Application.ScreenUpdating = True End Sub '-------------------------------------------- Function GetFName(sPath As String) As String ' ' Function that splits the filename from _ the path passed as parameter. Function _ returns the file name. '-------------------------------------------- GetFName = Right(sPath, Len(sPath) - InStrRev(sPath, "\")) End Function

floddy · Apr 21, 2015

Thank you sijpie

floddy · Apr 23, 2015

sijpie said:
Do While rNew.Value <> vbNullString
'go through each row until empty row
Set rOutp = wbDB.ActiveSheet.Columns("A").Find(rNew.Value, _
searchdirection:=xlNext)
If rOutp Is Nothing Then ' not found, so add
' find bottom row
Set rOutp = wbDB.ActiveSheet.Columns("A").Find(what:="*", _
after:=Cells(1, 1), _
searchdirection:=xlPrevious).Offset(1, 0)
End If
' set values to row of new data
rOutp.Resize(1, rNew.CurrentRegion.Columns.Count).Value = _
rNew.Resize(1, rNew.CurrentRegion.Columns.Count).Value

Set rNew = rNew.Offset(1, 0) ' one row down
Loop

Hello Again,

Thanks for your help.

I think in this part something needs to be changed, because at this point the code adds missing values at the end of my table, but it overwrites also values for founded value, which is not desired.

Can you please take a look once again?

Macro for checking if a value exists in a different workbook and adding it if it is missing

Sushajith

New Member

sijpie

Well-known Member

Sushajith

New Member

sijpie

Well-known Member

floddy

New Member

sijpie

Well-known Member

floddy

New Member

sijpie

Well-known Member

floddy

New Member

floddy

New Member

Similar threads

Share this page

Macro for checking if a value exists in a different workbook and adding it if it is missing

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

New Member

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock