PDA

View Full Version : VBA - update entry in other workbook if ID matches



Summertime
09-06-2017, 04:53 AM
Hello all,

I am stuck on a problem regarding updating my Excel database.
I have an entry file (WB1) where in one sheet data will be written (WB1.sheet("entry"). This data is copied to another sheet in WB1: WB1.sheet("data"). So I have all data I want in by database already in one row (same format as in database: A2:ZZ2).
Data can be saved in WB2=database.xls. Once row A2:ZZ2 will be pasted in WB2 a new ID is created and all data is saved in table format - so entry is written in next free row.

Now I would like to implement updating the database in WB2=database.xls when the ID is found in WB2=database.xls.
It is already possible to show the entry from WB2 again in WB1.sheet("entry") by entering the ID in one field "K6".

When I make changes in WB1.sheet("entry") I want to overwrite old entry in WB2=database.xls.
ID is in WB2=database.xls(sheet:"DB") in A:A.

So far I have the following but data is not overwritten:


Sub FindenUndKopieren()


Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet

Dim rng As Range
Dim ID As String


Set wbQuelle = ActiveWorkbook
Set wksQuelle = wbQuelle.Worksheets("Data")
Application.ScreenUpdating = False
strPfadZiel = "Y:........"
strPfadZiel = wbQuelle.path
strZiel = "Database.xlsx"

ID = wbQuelle.Worksheets("Entry").Range("K6")

If fncCheckWorkbookOpen(strZiel) Then
Set wbZiel = Application.Workbooks(strZiel)
bolOpen = True
Else
Set wbZiel = Application.Workbooks.Open(strPfadZiel & Application.PathSeparator _
& strZiel)
bolOpen = False
End If
Set wksZiel = wbZiel.Worksheets("DB")

Set rng = wksZiel.Range("A:A").Find(ID)
If rng Is Nothing Then
MsgBox "ID " & ID & " nicht gefunden!"
Else
wksQuelle.Range("A2:zz2").Copy
wksZiel.Select
rng.Select
ActiveSheet.Paste

Application.CutCopyMode = False

End If


End Sub


Can someone please help me?

p45cal
09-09-2017, 01:01 AM
Are you getting the 'nicht gefunden' message?
If so, there might be a problem with:
Set rng = wksZiel.Range("A:A").Find(ID)
.Find 'remembers' settings the last time it was used, especially the LookIn, LookAt and SearchFormat arguments:
LookIn: xlFormulas or xlValues (hidden cells aren't searched if you look for xlValues, formulas are searched if there are formulae, but the formula is the value if there are no formulae and hidden cells are searched)
LookAt: xlWhole or xlPart
SearchFormat: I usually set it to False.
So your final code line might be somethng like:
Set rng = wksZiel.Range("A:A").Find(What:=ID,Lookin:=xlWhole,LookAt:=xlFormulas,SearchFormat:=False)
(untested).

Summertime
09-20-2017, 07:23 AM
The message just appears when value does not exist in Database.
The line I want to overwrite is also found and activated.
There must be a problem with "activesheet.paste"
I do not understand why when line is activated the pasting does not work!?

Any ideas?

mdmackillop
09-20-2017, 10:35 AM
I can't see an issue in your code. To simplify though:

If rng Is Nothing Then
MsgBox "ID " & ID & " nicht gefunden!"
Else
wksQuelle.Range("A2:zz2").Copy Rng
Application.CutCopyMode = False
End If