Lookup copy and update master workbook

[DavidH56]

Hello,

I have a bit of a problem. Once a week I receive updates from several
sources that need to be input into my master workbook. I have twelve columns
of data including two date formatted columns and one hidden column. The
master workbook has anywhere from 1200 to 1500 rows. When I open the update
workbooks with updated information all updates are in red. Is there a way
using vba that after opening the updated workbook, I can have a macro in my
personal workbook that would by the click of a button, open the password
protected master workbook, lookup the id code located in column 4 and if the
same id code column 4 of the update workbook has red font in columns 5
through 12 in the updated workbook, have it copy that entire row as it and
paste it to the master workbook close and save the workbook. I will have as
many as 200 to 300 changes form each source to update. If I could get help
with this it would make life much easier for me and I would greatly
appreciate it. By the way I have row one as the column header. All
workbooks are formatted the same with the same type of data in all columns.
Thanks in advance for your assistance and direction.

 

[Joel]

Try this code. Change the location of the master workbook and the password.


Sub update_master()

Masterbk = "c:\temp\protected.xls"
Passwd = "123"

Set Updatesht = ActiveWorkbook.ActiveSheet


Set mstbk = Workbooks.Open(Filename:=Masterbk)
mstbk.Unprotect Password:=Passwd
Set mstsht = mstbk.Sheets("Sheet1")
mstsht.Unprotect Password:=Passwd

With Updatesht
RowCount = 2 'skip header
Do While .Range("E" & RowCount) <> ""
If .Range("E" & RowCount).Font.ColorIndex = 3 Then
IdCode = .Range("D" & RowCount)
Set c = mstsht.Columns(4).Find(what:=IdCode, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Cannot find Id Code : " & IdCode)
Else
.Rows(RowCount).Copy _
Destination:=Rows(c.Row)
End If
End If
RowCount = RowCount + 1
Loop

End With
mstsht.Protect Password:=Passwd
mstbk.Protect Password:=Passwd
mstbk.Close SaveChanges:=True

End Sub

 

[DavidH56]

Thanks Joel for the quick response,

I tried using the code but I keep getting type mismatch error at this point:

Masterbk = "J:\Temp\Master SVR.xls"

 

[DavidH56]

Joel, Thanks again Joel for your assistance.

I was able to get the code to run by retyping the location of the master
workbook once again. However, I'm prompted for the password although I've
loaded it into the code. Also most importantly, columns 7 through 17 has the
potential to have changes coded in red font so any of these rows need to be
copied to replace the one in the master workbook with red font displayed as
it is in the update workbook. Sorry I miscalculated the number of utilized
columns at first.

Thanks again so much for your assistance.

 

[Joel]

I don't know what is wrong with the password asking for conformation. I
didn't have the problem. You may need to change the variable FirstCol. Your
original posting was using column E (5th) now you are asking for G (7th).

Sub update_master()

Masterbk = "c:\temp\protected.xls"
Passwd = "123"
FirstCol = Range("G1").Column
LastCol = Range("Q1").Column

Set Updatesht = ActiveWorkbook.ActiveSheet

Set mstbk = Workbooks.Open(Filename:=Masterbk)
mstbk.Unprotect Password:=Passwd

Set mstsht = mstbk.Sheets("Sheet1")
mstsht.Unprotect Password:=Passwd

FirstCol = Range("G1").Column
LastCol = Range("Q1").Column

With Updatesht
RowCount = 2 'skip header
Do While .cells(RowCount, FirstCol) <> ""
FoundChange = False
For ColCount = FirstCol To LastCol
If .Cells(RowCount, ColCount).Font.ColorIndex = 3 Then
IdCode = .Range("D" & RowCount)
FoundChange = True
Exit For
End If
Next ColCount

If FoundChange = True Then
Set c = mstsht.Columns(4).Find(what:=IdCode, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Cannot find Id Code : " & IdCode)
Else
.Rows(RowCount).Copy _
Destination:=Rows(c.Row)
End If
End If
RowCount = RowCount + 1
Loop

End With
mstsht.Protect Password:=Passwd
mstbk.Protect Password:=Passwd
mstbk.Close SaveChanges:=True

End Sub

 

[DavidH56]

Thanks Joel,

The macro ran beautifully. You're brilliant. I made the adjustments and it
ran beautifully. It still prompts me for the password however. The workbook
is only write protected so others can still view it from read only. Would
that make a difference? Also, there is one other question I have for you.
The master workbook has the date in the name so could I open it with some
kind of wildcard statement so when the date is different it will still work?

Thanks again for you help. This really saves me a lot!!! of time manually
loading these changes. My hat is off to you.

 

[Joel]

Here are two solutions. the first loops through all masterbooks the 2nd does
exactly what you asked for.

Sub update_master1()

Folder = "c:\temp\"
Passwd = "123"
FirstCol = Range("G1").Column
LastCol = Range("Q1").Column

Set Updatesht = ActiveWorkbook.ActiveSheet

FName = Dir(Folder & "Protect*.xls")
Do While FName <> ""

Set mstbk = Workbooks.Open(Filename:=Folder & FName)
mstbk.Unprotect Password:=Passwd
Masterbk = "c:\temp\protected.xls"

Set mstsht = mstbk.Sheets("Sheet1")
mstsht.Unprotect Password:=Passwd

FirstCol = Range("G1").Column
LastCol = Range("Q1").Column

With Updatesht
RowCount = 2 'skip header
Do While .Cells(RowCount, FirstCol) <> ""
FoundChange = False
For ColCount = FirstCol To LastCol
If .Cells(RowCount, ColCount).Font.ColorIndex = 3 Then
IdCode = .Range("D" & RowCount)
FoundChange = True
Exit For
End If
Next ColCount

If FoundChange = True Then
Set c = mstsht.Columns(4).Find(what:=IdCode, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Cannot find Id Code : " & IdCode)
Else
.Rows(RowCount).Copy _
Destination:=Rows(c.Row)
End If
End If
RowCount = RowCount + 1
Loop

End With
mstsht.Protect Password:=Passwd
mstbk.Protect Password:=Passwd
mstbk.Close SaveChanges:=True

FName = Dir()
Loop
End Sub
Sub update_master2()

Folder = "c:\temp\" '<=added
Masterbk = Folder & Dir(Folder & "protected*.xls") '<=changed
Passwd = "123"
FirstCol = Range("G1").Column
LastCol = Range("Q1").Column

Set Updatesht = ActiveWorkbook.ActiveSheet

Set mstbk = Workbooks.Open(Filename:=Masterbk)
mstbk.Unprotect Password:=Passwd

Set mstsht = mstbk.Sheets("Sheet1")
mstsht.Unprotect Password:=Passwd

FirstCol = Range("G1").Column
LastCol = Range("Q1").Column

With Updatesht
RowCount = 2 'skip header
Do While .Cells(RowCount, FirstCol) <> ""
FoundChange = False
For ColCount = FirstCol To LastCol
If .Cells(RowCount, ColCount).Font.ColorIndex = 3 Then
IdCode = .Range("D" & RowCount)
FoundChange = True
Exit For
End If
Next ColCount

If FoundChange = True Then
Set c = mstsht.Columns(4).Find(what:=IdCode, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox ("Cannot find Id Code : " & IdCode)
Else
.Rows(RowCount).Copy _
Destination:=Rows(c.Row)
End If
End If
RowCount = RowCount + 1
Loop

End With
mstsht.Protect Password:=Passwd
mstbk.Protect Password:=Passwd
mstbk.Close SaveChanges:=True

End Sub

 

[DavidH56]

Thanks again Joel,

I used the method1. It works beautifully. Thanks so much. You are
brilliant!!!